从电子邮件消息中提取数据（或数千封电子邮件）[基于Exchange]

My marketing department, bless them, has decided to make a sweepstakes where people enter over a webpage. That is great but the information isn't stored to a DB of any sort but is sent to an exchange mail box as an email. Great.

我的营销部门,祝福他们,决定制作一个人们进入网页的抽奖活动。这很好,但信息不会存储到任何类型的数据库,而是作为电子邮件发送到交换邮箱。大。

My challenge is to extract the entry (and marketing info) from these emails and store them someplace more useful, say a flat file or CSV. The only saving grace is that the emails have a highly consistant format.

我的挑战是从这些电子邮件中提取条目(和营销信息)并将它们存储在更有用的位置,例如平面文件或CSV。唯一的优点是电子邮件具有高度一致的格式。

I am sure I could spend the time saving all the emails to files and then write an app to munge through them all but was hoping for a much more elegant solution. Can I programmatically access an exchange mailbox, read all the emails and then save that data?

我相信我可以花时间将所有电子邮件保存到文件中,然后编写一个应用程序来完成它们,但希望有一个更优雅的解决方案。我可以以编程方式访问交换邮箱,读取所有电子邮件,然后保存该数据吗?

2 个解决方案

#1

There's lots of different ways to get at the messages in an exchange mailbox, but since it seems this is something you're only going to want to run once to extract the data I'd suggest writing a VBA macro to run inside Outlook itself (having opened the exchange mailbox in question within Outlook). It's pretty easy to iterate through the mail items in a specific mailbox and read the body text from them. You can then write a text file with just the stuff you want.

有很多不同的方法来获取交换邮箱中的邮件,但是因为看起来这只是你想要运行一次以提取数据我建议编写一个VBA宏来运行Outlook本身(在Outlook中打开了有问题的交换邮箱)。迭代特定邮箱中的邮件项并从中读取正文文本非常容易。然后,您可以只使用所需的内容编写文本文件。

#2

Here is the code I used....

这是我用过的代码....

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