從電子郵件中提取數據（或數千封電子郵件）[Exchange]

Question

我的營銷部門，保佑他們，決定在人們通過網頁進行抽獎活動。這很棒，但信息並不存儲到任何類型的數據庫中，而是作爲電子郵件發送到交換郵箱。大。

我的挑戰是從這些電子郵件中提取條目（和市場營銷信息），並將它們存儲在更有用的地方，比如平面文件或CSV。唯一的優點是電子郵件具有高度一致的格式。

我相信我可以花時間把所有的電子郵件都保存到文件中，然後編寫一個應用程序來通過它們，但希望得到更優雅的解決方案。我可以通過編程訪問交換郵箱，閱讀所有電子郵件並保存該數據嗎？

Answer 1

有很多不同的方式來獲取交換郵箱中的郵件，但由於看起來這是你只想運行一次來​​提取數據，我建議編寫一個VBA宏來運行Outlook本身內部（在Outlook中打開了有問題的交換郵箱）。迭代特定郵箱中的郵件並從中讀取正文文本非常簡單。然後你可以用你想要的東西寫一個文本文件。

Answer 2

這裏是我使用的代碼....

Private Sub btnGo_Click() 
    If ComboBox1.SelText <> "" Then 
    Dim objOutlook As New Outlook.Application 
    Dim objNameSpace As Outlook.NameSpace 
    Dim objInbox As MAPIFolder 
    Dim objMail As mailItem 

    //Get the MAPI reference 
    Set objNameSpace = objOutlook.GetNamespace("MAPI") 

    //Pick up the Inbox 
    Set objInbox = objNameSpace.GetDefaultFolder(olFolderInbox) 
    For Each objFolder In objInbox.Folders 
     If (objFolder.Name = ComboBox1.SelText) Then 
      Set objInbox = objFolder 
     End If 
    Next objFolder 

    //Loop through the items in the Inbox 
    Dim count As Integer 
    count = 1 

    For Each objMail In objInbox.Items 
     lblStatus.Caption = "Count: " + CStr(count) 
     If (CheckBox1.Value = False Or objMail.UnRead = True) Then 
      ProcessMailItem (objMail.Body) 
      count = count + 1 
      objMail.UnRead = False 
     End If 
    Next objMail 
    End If 
End Sub 

Private Sub ProcessMailItem(strBody As String) 
    Open "C:\file.txt" For Append As 1 

    Dim strTmp As String 
    strTmp = Replace(strBody, vbNewLine, " ") 
    strTmp = Replace(strTmp, vbCrLf, " ") 
    strTmp = Replace(strTmp, Chr(13) & Chr(10), " ") 
    strTmp = Replace(strTmp, ",", "_") 

    //Extra Processing went here (Deleted for brevity) 
    Print #1, strTmp 
    Close #1 

End Sub 

Private Function Strip(strStart As String, strEnd As String, strBody As String) As String 
    Dim iStart As Integer 
    Dim iEnd As Integer 

    iStart = InStr(strBody, strStart) + Len(strStart) 
    If (strEnd = "xxx") Then 
     iEnd = Len(strBody) 
    Else 
     iEnd = InStr(strBody, strEnd) - 1 
    End If 

    Strip = LTrim(RTrim(Mid(strBody, iStart, iEnd - iStart))) 
End Function 


Private Sub UserForm_Initialize() 
    Dim objOutlook As New Outlook.Application 
    Dim objNameSpace As Outlook.NameSpace 
    Dim objInbox As MAPIFolder 
    Dim objFolder As MAPIFolder 

    //Get the MAPI reference 
    Set objNameSpace = objOutlook.GetNamespace("MAPI") 

    //Pick up the Inbox 
    Set objInbox = objNameSpace.GetDefaultFolder(olFolderInbox) 

    //Loop through the folders under the Inbox 
    For Each objFolder In objInbox.Folders 
    ComboBox1.AddItem objFolder.Name 
    Next objFolder 
End Sub