Import e-mail w attachments into Access 2007 from Outlook 2007

[FeS2]

I am trying to import e-mail from Outlook 2007 into an Access 2007 table. I can import the entire e-mail except for the attachments. I have the following code but get an "Invalid Argument" on the rstAttachment.Fields("FileData") = moAttachment line. For background info, I do not want to save the attachments to the hard drive or a network location, I want them stored in the attachment field in Access.


Sub Load_Mail()

Dim rstAUtemp As DAO.Recordset2
Dim rstAttachment As DAO.Recordset2
Dim OlApp As Outlook.Application
Dim Inbox As Outlook.MAPIFolder
Dim InboxItems As Outlook.Items
Dim MailObject As Object
Dim moAttachment As Outlook.Attachment

Set OlApp = CreateObject("Outlook.Application")
Set Inbox = OlApp.GetNamespace("Mapi").Folders("Mailbox - Address Updates").Folders("Inbox")
Set rstAUtemp = CurrentDb.OpenRecordset("tbl_AU_Staging")

rstAUtemp.AddNew

Set InboxItems = Inbox.Items

For Each MailObject In InboxItems
If MailObject.UnRead Then
With rstAUtemp

.AddNew
!BCC = MailObject.BCC
!Body = MailObject.Body
!CC = MailObject.CC
!ConversationTopic = MailObject.ConversationTopic
!CreationTime = MailObject.CreationTime
!EntryID = MailObject.EntryID
!FlagDueBy = MailObject.FlagDueBy
!FlagRequest = MailObject.FlagRequest
!FlagStatus = MailObject.FlagStatus
!Importance = MailObject.Importance
!ReceivedTime = MailObject.ReceivedTime
!ReminderTime = MailObject.ReminderTime
!SenderName = MailObject.SenderName
!Sensitivity = MailObject.Sensitivity
!SentOn = MailObject.SentOn
!Size = MailObject.Size
!Subject = MailObject.Subject
!To = MailObject.To
!HasAttachment = MailObject.Attachments.Count
If MailObject.Attachments.Count > 0 Then
Set rstAttachment = rstAUtemp.Fields("Attachments").Value
rstAttachment.AddNew
For Each moAttachment In MailObject.Attachments
rstAttachment.Fields("FileData") = moAttachment
Next moAttachment
rstAttachment.Update
End If
!UnRead = MailObject.UnRead
!Load_dte = Now()
.Update
End With
End If
Next

End Sub

 

[kjv1611]

Not sure if this the issue or not, but it looks like you had some items ordered incorrectly. For one, you should only need to set an instance to the Recordset object for your attachments table once. Another is that you were creating a new item, and THEN looping through the attachments. However, if you've got multiple attachments, you need multiple records - one for each attachment. So you should have an ItemID, EmailID, or however you reference the message, along with the attachment.

At least that's my understanding of it.

Take a look at the following, and see if the changes help you.

Sub Load_Mail()

Dim rstAUtemp As DAO.Recordset2
Dim rstAttachment As DAO.Recordset2
Dim OlApp As Outlook.Application
Dim Inbox As Outlook.MAPIFolder
Dim InboxItems As Outlook.Items
Dim MailObject As Object
Dim moAttachment As Outlook.Attachment

Set OlApp = CreateObject("Outlook.Application")
Set Inbox = OlApp.GetNamespace("Mapi").Folders("Mailbox - Address Updates").Folders("Inbox")
Set rstAUtemp = CurrentDb.OpenRecordset("tbl_AU_Staging")
Set rstAttachment = rstAUtemp.Fields("Attachments").Value

rstAUtemp.AddNew

Set InboxItems = Inbox.Items

For Each MailObject In InboxItems
    If MailObject.UnRead Then
    With rstAUtemp
        
        .AddNew
        !BCC = MailObject.BCC
        !Body = MailObject.Body
        !CC = MailObject.CC
        !ConversationTopic = MailObject.ConversationTopic
        !CreationTime = MailObject.CreationTime
        !EntryID = MailObject.EntryID
        !FlagDueBy = MailObject.FlagDueBy
        !FlagRequest = MailObject.FlagRequest
        !FlagStatus = MailObject.FlagStatus
        !Importance = MailObject.Importance
        !ReceivedTime = MailObject.ReceivedTime
        !ReminderTime = MailObject.ReminderTime
        !SenderName = MailObject.SenderName
        !Sensitivity = MailObject.Sensitivity
        !SentOn = MailObject.SentOn
        !Size = MailObject.Size
        !Subject = MailObject.Subject
        !To = MailObject.To
        !HasAttachment = MailObject.Attachments.Count
        If MailObject.Attachments.Count > 0 Then
            For Each moAttachment In MailObject.Attachments
                rstAttachment.AddNew
                rstAttachment.Fields("FileData") = moAttachment
                rstAttachment.Update
            Next moAttachment
        End If
        !UnRead = MailObject.UnRead
        !Load_dte = Now()
        .Update
    End With
    End If
Next

End Sub

Post back with your results.