Extract data from an email message (or several thousand emails) [Exchange based]

My marketing department, bless them, decided to make a lottery where people get to a web page. This is great, but the information is not stored in any type of database, but is sent to the exchange mailbox in the form of email. Fine.

My task is to extract the record (and marketing information) from these letters and keep them somewhere more useful, say a flat file or CSV. The only savings are that emails are formatted with a high degree of consistency.

I am sure that I can spend time saving all emails in files, and then write an application to simulate everything, but I hoped for a much more elegant solution. Can I programmatically access the exchange mailbox, read all emails and save this data?

+3
source share
2 answers

, , , , , VBA Outlook ( Outlook). . .

+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
+6

All Articles