如何在使用VBA閱讀Outlook電子郵件時包含回覆？

我正在閱讀Outlook收件箱和發送文件夾電子郵件的給定地址和填充Access表。我的例程沒有選擇「回覆」電子郵件。我認爲他們會在發送的文件夾中。我目前沒有任何子文件夾。有關我失蹤或不明白的任何想法？這是我第一次閱讀Outlook數據。如何在使用VBA閱讀Outlook電子郵件時包含回覆？

Sub GetFromInbox(strInboxSent As String, strForAddress As String) 
    Dim olFolderInboxSent As Integer 

    Select Case strInboxSent 
     Case "InBox" 
      olFolderInboxSent = 6 '6 = InBox, Sent = 5 
     Case "Sent" 
      olFolderInboxSent = 5 
    End Select 

    Dim olApp As Object, olNs As Object 
    Dim oRootFldr As Object ' Root folder to start 
    Dim lCalcMode As Long 

    Set olApp = CreateObject("Outlook.Application") 
    Set olNs = olApp.GetNamespace("MAPI") 
    Set oRootFldr = olNs.GetDefaultFolder(olFolderInboxSent) 

    GetFromFolder oRootFldr, strForAddress, olFolderInboxSent 
    Set oRootFldr = Nothing 
    Set olNs = Nothing 
    Set olApp = Nothing 
End Sub 

Private Sub GetFromFolder(oFldr As Object, strForAddress As String, intInboxSent As Integer) 

    'Load Worktable with sent emails 
    Dim cmd As ADODB.Command 
    Dim rst As ADODB.Recordset 
    Set cmd = New ADODB.Command 
    cmd.ActiveConnection = CurrentProject.Connection 

    Set rst = New ADODB.Recordset 
    rst.LockType = adLockOptimistic 
    cmd.CommandText = "Select * From wtblEmails" 
    rst.Open cmd 

    Dim oItem As Object, oSubFldr As Object 

    ' Process all mail items in this folder 
    For Each oItem In oFldr.Items 
    Debug.Print TypeName(oItem) 
     If TypeName(oItem) = "MailItem" Then 
      With oItem 
       Select Case intInboxSent 
        Case 6 
         If .SenderEmailAddress = strForAddress Then 
          'Debug.Print .Subject, .SenderName, .SenderEmailAddress, .EntryID 
          rst.AddNew 
          rst!weDate = .CreationTime 
          rst!weRcvdSent = "R" 
          rst!weWith = .SenderEmailAddress 
          rst!weSubject = .Subject 
          rst!weBody = .Body 
          rst!weid = .EntryID 
          rst.Update 
         End If 
        Case 5 
         If .To = strForAddress Then 
          'Debug.Print .Subject, .SenderName, .SenderEmailAddress, .EntryID 
          rst.AddNew 
          rst!weDate = .CreationTime 
          rst!weRcvdSent = "S" 
          rst!weWith = .To 
          rst!weSubject = .Subject 
          rst!weBody = .Body 
          rst!weid = .EntryID 
          rst.Update 
         End If 
        End Select 
      End With 
     End If 
    Next 

    ' Recurse all Subfolders 
    For Each oSubFldr In oFldr.Folders 
     GetFromFolder oSubFldr, strForAddress, intInboxSent 
    Next 
End Sub

來源

2017-05-23 M. Meier

有問題的郵件是否真的在「發送」文件夾中？ –

這可能是交換地址與SMTP地址的情況。在發送文件夾中的回覆郵件地址上執行debug.print。 https://stackoverflow.com/questions/13516624/converting-exchange-email-to-smtp-email – niton

調試解釋了原因，但我沒有看到可能是解決方案的屬性。在最初發送的郵件項目中，「.TO」是收件人的電子郵件地址。但在我發送的與該電子郵件相關的回覆中，「.TO」是收件人姓名，而不是地址。當我查看這些屬性時，我沒有看到可能是回覆條目中的收件人電子郵件地址。感謝讓我走得這麼遠。有關如何閱讀發送到指定地址的電子郵件和回覆的任何想法？謝謝！ –

這是我發現的作品。發送郵件的收件人地址列表可在此處找到。對於每個電子郵件項目，我都會調用此函數來查看我要查找的地址是否在收件人列表中。

Public Function fncWasMailSentTo(mail As Outlook.MailItem, strAddress As String) As Boolean 
    Dim recips As Outlook.Recipients 
    Dim recip As Outlook.Recipient 
    Dim pa As Outlook.PropertyAccessor 
    Const PR_SMTP_ADDRESS As String = _ 
     "http://schemas.microsoft.com/mapi/proptag/0x39FE001E" 
    Set recips = mail.Recipients 

    fncWasMailSentTo = False 

    For Each recip In recips 
     Set pa = recip.PropertyAccessor 
     'Debug.Print recip.Name & " SMTP=" & pa.GetProperty(PR_SMTP_ADDRESS) 
     If pa.GetProperty(PR_SMTP_ADDRESS) = strAddress Then 
      fncWasMailSentTo = True 
      Exit For 
     End If 
    Next 
End Function

來源

2017-05-26 11:18:41

如何在使用VBA閱讀Outlook電子郵件時包含回覆？

回答

相關問題