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!
ZanetabetaAsked:
Who is Participating?
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
    
LocalError:
  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
    
LocalError:
  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.
0

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, _
   Range:=strRange

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", _
      hasfieldnames:=False

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")

SelectMailFolder:
   '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, _
         Title:=strTitle
      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
   Else
      '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, _
               hasfieldnames:=True
            
            '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, _
      Title:=strTitle
   
ErrorHandlerExit:
   Exit Sub

ErrorHandler:
   'Outlook is not running; open Outlook with CreateObject
   If Err.Number = 429 Then
      Set appOutlook = CreateObject("Outlook.Application")
      Resume Next
   Else
      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.)
0
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
0
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.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.