Excel(VBA)マクロでgmailを読み込む

Excelでgmailを送るのはサンプルがたくさん出ていたのですが、やっとこさgmailを受信する方法を見つけたのでメモ。

用途として、オラインショップ等メールで受注情報が届くような運用をしている場合、メールの本文をそのままデータ形成して、表に取り込む等が出来るますね～。

前提条件として、「EAGetMail」とやらをインストールする必要有り。

外国の方のコード丸コピーで心苦しいですがこんな感じ。

[注]
attachmentプロパティで添付ファイルも取得できますが、データが大きい場合メモリ不足のエラーがでる。同様にHTMLファイルが添付ファイルの場合、デコードされていない生データなので何らかの対応が必要。

Option Explicit

Const MailServerPop3 = 0
Const MailServerImap4 = 1
Const MailServerEWS = 2
Const MailServerDAV = 3


Private Sub CommandButton1_Click()
  Dim curpath As String
    Dim mailbox As String
    Dim oTools As New EAGetMailObjLib.Tools
    
    ' Create a folder named "inbox" under current directory
    ' to save the email retrieved.
    curpath = "メール保存先フォルダ(emlファイル）"
    mailbox = curpath & "\inbox"
    oTools.CreateFolder mailbox
    
    Dim oServer As New EAGetMailObjLib.MailServer
    ' Gmail IMAP server address
    oServer.Server = "imap.gmail.com"
    oServer.User = "アカウント@gmail.com"
    oServer.Password = "パスワード"
    oServer.Protocol = MailServerImap4
    
    ' Enable SSL Connection
    oServer.SSLConnection = True
    
    ' Set 993 SSL Port
    oServer.Port = 993
    
    On Error GoTo ErrorHandle:
    Dim oClient As New EAGetMailObjLib.MailClient
    oClient.LicenseCode = "TryIt"
    
    oClient.Connect oServer
    MsgBox "Connected"
    
    Dim infos
    infos = oClient.GetMailInfos()
    MsgBox UBound(infos) + 1 & " emails"

    Dim i As Integer
    For i = LBound(infos) To UBound(infos)
        Dim info As EAGetMailObjLib.MailInfo
        Set info = infos(i)
        MsgBox "Index: " & info.Index & "; Size: " & info.Size & _
        "; UIDL: " & info.UIDL
        
        ' Receive email from Gmail server
        Dim oMail As EAGetMailObjLib.Mail
        Set oMail = oClient.GetMail(info)
        
        MsgBox "From: " & oMail.From.Address & _
            vbCrLf & "Subject: " & oMail.Subject & _
            vbCrLf & "Subject: " & oMail.HTMLBody
        
        Dim fileName As String
        ' Generate a random file name by current local datetime,
        ' emlファイルでメールを保存したい場合
        ' fileName = mailbox & "\" & oTools.GenFileName(i) & ".eml"
        ' Save email to local disk
        ' oMail.SaveAs fileName, True
        
        ' Mark email as deleted from Gmail server.
        oClient.Delete info
    Next
    
    ' Quit and pure emails marked as deleted from Gmail server.
    oClient.Quit
    Exit Sub

ErrorHandle:
    MsgBox Err.Description
End Sub

あ〜，1からVBA勉強し直したい。。。SE必須の能力ですな。