Opening Outlook E-mail attachments in Access

[FeS2]

What I need to do:
We receive e-mails into Outlook 2003 that have an Excel attachment. I am trying to figure out a way to have Access find the e-mails from the specific sender and either open and import the attachment to a table or just link the attachment as a table.

So far I can only link/import the inbox as a table but it only tells me if there is an attachment but does not let me do anything else.

Is there a simple way to do this?

Thanks
Tim

 

[CautionMP]

FeS2,
Simple is relative. In my opinion you have two questions[ol][li]How to systematically save email attachments.[/li][li]How to batch import external files into a database.[/li][/ol]

Here is one possible solution to item 1.

[navy]Sub [/navy] CheckInbox()
On [navy]Error Goto[/navy] CheckInbox_err
Const cSaveFileFolder [navy]As String[/navy] = "C:\"
[navy]Dim[/navy] appOutlook [navy]As Object[/navy], objNameSpace [navy]As Object[/navy]
[navy]Dim[/navy] fldDefault [navy]As Object[/navy], objMailItem [navy]As Object[/navy]
[navy]Dim[/navy] varMailAttachements [navy]As Variant[/navy]
[navy]Dim[/navy] blnCloseOutlook [navy]As Boolean[/navy]
[navy]Dim[/navy] intMailAttachement [navy]As Integer[/navy]
[navy]Dim[/navy] strSaveFileName [navy]As String[/navy]

[green]'Get the current instance of Outlook, or create a new one[/green]
Set appOutlook = GetObject(, "Outlook.Application")
[navy]If[/navy] Err.Number <> 0 [navy]Then[/navy]
  Set appOutlook = CreateObject("Outlook.Application")
  blnCloseOutlook = [navy]True[/navy]
[navy]End If[/navy]

[green]'Get the default Inbox[/green]
Set objNameSpace = appOutlook.GetNamespace("MAPI")
Set fldDefault = objNameSpace.GetDefaultFolder(6)  [green]'olFolderInbox[/green]

[green]'Loop through all the items in the Inbox[/green]
[navy]For Each[/navy] objMailItem In fldDefault.Items
 [navy]If[/navy] objMailItem.Class = 43 [navy]Then[/navy]  [green]'olMail[/green]
    [green]'Test For the recipient here[/green]
    Debug.Print objMailItem.SenderName
    [green]'Grab the Attachements collection[/green]
    Set varMailAttachements = objMailItem.Attachments
    [green]'Check If there are attachements[/green]
    [navy]If[/navy] varMailAttachements.Count <> 0 [navy]Then[/navy]
      [green]'Loop through the attachements[/green]
      [navy]For[/navy] intMailAttachement = 1 [navy]To[/navy] varMailAttachements.Count
        [green]'Save the attachement, append Date/time stamp in[/green]
        [green]'case attachements have the same name[/green]
        strSaveFileName = cSaveFileFolder & _ 
                          Format(objMailItem.SentOn, "yyyy-mm-dd_hhnn_") & _
                          varMailAttachements(intMailAttachement).FileName
        varMailAttachements(intMailAttachement).SaveAsFile strSaveFileName
      [navy]Next[/navy] intMailAttachement
    [navy]End If[/navy]
  [navy]End If[/navy]
[navy]Next[/navy] objMailItem
CleanUP:
Set varMailAttachements = [navy]Nothing[/navy]
Set fldDefault = [navy]Nothing[/navy]
Set objNameSpace = [navy]Nothing[/navy]
[navy]If[/navy] blnCloseOutlook [navy]Then[/navy]
  appOutlook.Quit
[navy]End If[/navy]
Set appOutlook = [navy]Nothing[/navy]
[navy]Exit Sub [/navy]
CheckInbox_err:
Debug.Print Err.Number, Err.Description
Resume [navy]Next[/navy]
[navy]End Sub [/navy]

For item 2 you can use the appropriate [tt]DoCmd.Transfer...[/tt] in conjunction with the [tt]Dir()[/tt] function to batch import all the files in a specific directory with a single routine.

Hope this helps,
CMP

(GMT-07:00) Mountain Time (US & Canada)