Parsing emails using VBA

断了今生、忘了曾经 提交于 2020-01-25 07:55:06

问题


I'm trying to pull data in from emails that meet the following criteria: they must include data that is set up in a table like the picture attached.table From there, I want to pull in each line into a column on excel.

I am also trying to pull it in from a certain inbox (I have 3 inboxes on my email). Does anyone have any recommendations of what I can add to this code?

Option Explicit

Sub CommandButton1_Click()
    On Error GoTo ErrHandler

    ' SET Outlook APPLICATION OBJECT.
    Dim objOutlook As Object
    Set objOutlook = CreateObject("Outlook.Application")

    ' CREATE AND SET A NameSpace OBJECT.
    Dim objNSpace As Object
    ' THE GetNameSpace() METHOD WILL REPRESENT A SPECIFIED NAMESPACE.
    Set objNSpace = objOutlook.GetNamespace("MAPI")

    ' CREATE A FOLDER OBJECT.
    Dim myFolder As Object
    Set myFolder = objNSpace.GetDefaultFolder(MCPricing)

    Dim Item As Object
    Dim iRows, iCols As Integer
    iRows = 2

    ' LOOP THROUGH EACH ITEMS IN THE FOLDER.
    For Each objItem In myFolder.Items
        If objItem.Class = olMail Then

            Dim objMail As Outlook.MailItem
            Set objMail = objItem

            Cells(iRows, 1) = objMail.SenderEmailAddress
            Cells(iRows, 2) = objMail.To
            Cells(iRows, 3) = objMail.Subject
            Cells(iRows, 4) = objMail.ReceivedTime
        End If

        ' SHOW OTHER PROPERTIES, IF YOU WISH.
        'Cells(iRows, 6) = objMail.Body
        'Cells(iRows, 5) = objMail.CC
        'Cells(iRows, 6) = objMail.BCC
        'Cells(iRows, 4) = objMail.Recipients(1)

        iRows = iRows + 1
    Next
    Set objMail = Nothing

    ' RELEASE.
    Set objOutlook = Nothing
    Set objNSpace = Nothing
    Set myFolder = Nothing
ErrHandler:
    Debug.Print Err.Description
End Sub

来源:https://stackoverflow.com/questions/59414685/parsing-emails-using-vba

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!