VBA Code for XML email to Access

Hello Experts,

I am new to VBA and am trying to figure out how I could accomplish the following:

I have an excel template that is filled out by many employees and e-mailed daily. Data from worksheet is e-mailed as XML in an email body.

What I am trying to do is get this data into Access DB.
I guess I would need to:
1)  get a reference to the inbox
2)  iterate through the emails and parse the xml
3)  create a recordset and add the values from the xml in 2 above

Can someone please provide some samples of VBA code of how would one achieve this?

Thanks much!
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

ste5anSenior DeveloperCommented:
Well, what does "as XML as e-mail body" mean?

E.g. when it's an attachment:

Option Compare Database
Option Explicit

Public Sub OutlookAutomation_ImportInbox()

  On Local Error GoTo LocalError

  Dim olApp As Object   'Outlook.Application
  Dim olInbox As Object 'MAPIFolder
  Dim olItem As Object  'Outlook.MailItem

  On Local Error Resume Next
  Set olApp = GetObject(, "Outlook.Application")
  If Err.Number = 429 Then
    Set olApp = CreateObject("Outlook.Application")
  End If
  On Local Error GoTo LocalError
  Set olInbox = GetDefaultFolder(olApp, olFolderInbox)
  For Each olItem In olInbox.Items
    If TypeName(olItem) = "MailItem" Then
      ExtractData olItem
    End If
  Next olItem
  Set olItem = Nothing
  Set olInbox = Nothing
  Set olApp = Nothing
  Exit Sub
  Set olItem = Nothing
  Set olInbox = Nothing
  Set olApp = Nothing

End Sub

Private Sub ExtractData(AMailItem As Object)

  Const ATTACHMENT_INFO As String = "data.xml"

  On Local Error GoTo LocalError

  Dim olAttachments As Object 'Outlook.Attachments
  Dim olAttachment As Object 'Outlook.Attachment

  Set olAttachments = AMailItem.Attachments
  Set olAttachment = olAttachments(ATTACHMENT_INFO)
  If Not olAttachment Is Nothing Then
    olAttachment.SaveAsFile SettingJobApplicationPath & olAttachment.FileName
  End If
  Set olAttachment = Nothing
  Set olAttachments = Nothing
  Exit Sub
  Set olAttachment = Nothing
  Set olAttachments = Nothing

End Sub

Private Function GetDefaultFolder(AApplication As Object, ADefaultFolder As EnumOutlookOlDefaultFolders) As Object
  Dim olNamespace As Object

  Set olNamespace = AApplication.GetNamespace("MAPI")
  Set GetDefaultFolder = olNamespace.GetDefaultFolder(ADefaultFolder)
  Set olNamespace = Nothing
End Function

Open in new window

When it's really the body, then you need to scan for XML in it. Caveat: you should filter your e-mails by sender or subject prior to that.

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Helen FeddemaCommented:
I would suggest saving the Excel data as an .xls file, which could then be imported into Access quite easily, using the TransferSpreadsheet method:

strPath = Application.CurrentProject.Path
strWorkbook = strPath & "Customers.xls"
strRange = [as needed]

DoCmd.TransferSpreadsheet transfertype:=acImport, _
   spreadsheettype:=acSpreadsheetTypeExcel9, _
   tablename:=strTable, _
   FileName:=strWorkbook, _ 
   hasfieldnames:=True, _

Open in new window

Or, as a .csv file, which could be imported using the TransferText method:

Private Sub cmdImportTextDelimited_Click()

   DoCmd.TransferText transfertype:=acImportDelim, _
      tablename:="tblMonthlyData", _
      FileName:="D:\Documents\Examples\Monthly Data.csv", _

End Sub

Open in new window

The .xls or .csv file could be emailed as an attachment, then extracted from the email in Access, like this:

Public Sub ImportCSVMailMessages()
'Created by Helen Feddema 21-Jan-2012
'Last modified by Helen Feddema 13-Feb-2012

On Error GoTo ErrorHandler

   Dim lngCount As Long
   Dim lngItem As Long
   Dim strTable As String
   Dim strCSVFilePath As String
   Dim strCSVFileAndPath As String
   Dim fldProcessed As Outlook.Folder
   Set appOutlook = GetObject(, "Outlook.Application")
   Set nms = appOutlook.GetNamespace("MAPI")

   'Let the user select an Outlook folder to process

On Error Resume Next
   Set fld = nms.PickFolder
   Debug.Print "Folder item type: " & fld.DefaultItemType
   If fld Is Nothing Then
      GoTo ErrorHandlerExit
   ElseIf fld.DefaultItemType <> olMailItem Then
      strPrompt = "Please select a Mail folder"
      strTitle = "Folder error"
      MsgBox prompt:=strPrompt, _
         Buttons:=vbExclamation + vbOKOnly, _
      GoTo SelectMailFolder
   End If

   'Check for existence of Processed Items folder
   Set fldProcessed = fld.Folders("Processed Items")
   If fldProcessed Is Nothing Then
      Set fldProcessed = fld.Folders.Add("Processed Items")
   End If
On Error GoTo ErrorHandler
   strCSVFilePath = GetProperty("CSVFilePath", "") & "\"
   If TestPath(GetProperty("CSVFilePath", "")) = False Then
      GoTo ErrorHandlerExit
   End If
   lngItemCount = fld.Items.Count
   Debug.Print "Number of items in folder: " _
      & lngItemCount
   If lngItemCount = 0 Then
      MsgBox "No messages in selected folder; exiting:"
      GoTo ErrorHandlerExit
      'Clear table of old data
      DoCmd.SetWarnings False
      strTable = "tblUpdatedNorthwindOrders"
      strSQL = "DELETE * FROM " & strTable
      DoCmd.RunSQL strSQL
   End If
   'Process items in selected folder
   lngItemCount = 0
   'Work backwards to avoid skipping items
   lngCount = fld.Items.Count
   For lngItem = lngCount To 1 Step -1
      Set itm = fld.Items(lngItem)
      If itm.Class = olMail Then
         Set msg = itm
         If msg.Subject = "Updated Northwind Orders" Then
            'Save CSV attachment to folder, and then to table
            Set att = msg.Attachments(1)
            Debug.Print "Attachment file name: " & att.FileName
            strCSVFileAndPath = strCSVFilePath & att.FileName
            att.SaveAsFile strCSVFileAndPath
            'Import data into new table
            DoCmd.TransferText transfertype:=acImportDelim, _
               TableName:=strTable, _
               FileName:=strCSVFileAndPath, _
            'Run update query to update tblNorthwindOrders
            'with new data from .csv file
            DoCmd.OpenQuery "qupdNorthwindOrders"
            lngItemCount = lngItemCount + 1
            msg.Move fldProcessed
         End If
      End If
   Next lngItem
   If lngItemCount = 0 Then
      strPrompt = "No Northwind orders updated"
   ElseIf lngItemCount = 1 Then
      strPrompt = "1 Northwind order updated"
   ElseIf lngItemCount > 1 Then
      strPrompt = lngItemCount & " Northwind orders updated"
   End If
   strTitle = "Import from CSV files done"
   MsgBox prompt:=strPrompt, _
      Buttons:=vbInformation + vbOKOnly, _
   Exit Sub

   'Outlook is not running; open Outlook with CreateObject
   If Err.Number = 429 Then
      Set appOutlook = CreateObject("Outlook.Application")
      Resume Next
      MsgBox "Error No: " & Err.Number _
         & " in ImportCSVMailMessages procedure" _
         & "; Description: " & Err.Description
      Resume ErrorHandlerExit
   End If

End Sub

Open in new window

(The above code is from my Working with Outlook ebook.)
ZanetabetaAuthor Commented:
Thank you, Ste5an. Actual XML is in email body. Since there 150+ emails daily and possibly will be even more, I specifically wanted to not have attachments to keep things simpler. Sample e-mail (with almost all XML - some cut off on the side) is below.
Accountants are using a dedicated DL (distribution list) which could be set up as a separate folder in Inbox and all e-mails begin with "Cash Report for*" so I would think scanning for these e-mails should not be complicated. I am learning VBA but I it will take me some time to master the code.

Also, as an option I was going to explore if code could pull these from SharePoint library is these are e-mailed to SharePoint directly as seen below. But I was going to think of this later, once I solve for importing data at all.


emails sent directly to SP libraryemail-xml.PNG
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Access

From novice to tech pro — start learning today.