Outlook Insert Into attachments into Access Table

[Deke]

Hi All,
I've setup a simple process in Outlook VBA when an email comes in it will grab the Sender, Subject, Body and received time from the email and dump it into a table (ITtbl) in Access. The problem I'm having is, I also want to attach the entire email in the access table.

I've setup an attachment field called "Attachment". The problem is I'm getting an "Object variable or with block variable not set" error on the

Mattach = MyMail.attachments

line.
I'm also thinking I don't have the correct syntax in my Insert line.

I've done some research but everything I've found is excel based based using the DAO recordset to add to the database.
Is what I'm trying to do even possible? Any help or push in the right direction would be greatly appreciated.

Code:

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
'On Error Resume Next

'Mail Definitions
Dim MyMail As MailItem
Set MyMail = Application.Session.GetItemFromID(EntryIDCollection)

Dim MSub As String, MSender As String, MBody As String, Mtime As Date, Mattach As Attachment

MSub = MyMail.Subject
MSender = MyMail.Sender
MBody = MyMail.Body
Mtime = MyMail.ReceivedTime
Mattach = MyMail.attachments

If MyMail.Subject = "*Proof*" Then
'INSERT Query
Dim str As String
str = "INSERT INTO ITtbl ([From], [Subject], [Body], [Received], [Attachment]) VALUES (" & "'" & MSender & "'" & ", " & "'" & MSub & "'" & ", " & "'" & MBody & "'" & ", " & "'" & Mtime & "'" & ", " & Mattach & ")"

'Access Connection
Dim cnx As ADODB.Connection
Set cnx = New ADODB.Connection

cnx.Provider = "Microsoft.ACE.OLEDB.12.0"
cnx.ConnectionString = "\\data\Test Database\dbBE\CID_be.accdb"
cnx.Open
cnx.Execute str
Else
End If
End Sub

 

[MarkK]

If you are assigning an object instance to an object variable, you need to use the Set keyword.

Set Mattach = MyMail.attachments

 

[arnelgp]

I've setup an attachment field called "Attachment"

Attachment field can Bloat your db in no time.

 

[Deke]

If you are assigning an object instance to an object variable, you need to use the Set keyword.

Set Mattach = MyMail.attachments

Gotcha! I will give this a test. Also is my syntax right for my insert into line? I know I was playing around with it at one point and getting some strange syntax errors. Once I give this a try I'll see if they pop up.

 

[Deke]

Attachment field can Bloat your db in no time.

Yeah I understand it probably will at some point but I am putting in some filtering in the code because only a specific email type will be added to the table. Appreciate the warning though.

 

[Deke]

If you are assigning an object instance to an object variable, you need to use the Set keyword.

Set Mattach = MyMail.attachments

Okay so in testing getting a type mismatch? should I be using a different DIM definition?

 

[ebs17]

"the entire email" is something other than the attachments of the mail.
You can save the email as a whole on the hard disk, it will be an MSG file.

Attachments of the email would have to be saved individually to the hard disk.

In both cases you could load the resulting files into the database, but this is regularly not a good idea. It is better to store the files in a structured way in a file system and to include the paths of these files in your database in connection with the ID of the process.

 

[MarkK]

Okay so in testing getting a type mismatch? should I be using a different DIM definition?

There are two types, Attachment and Attachments, and they are not the same.

 

[Deke]

"the entire email" is something other than the attachments of the mail.
You can save the email as a whole on the hard disk, it will be an MSG file.

Attachments of the email would have to be saved individually to the hard disk.

In both cases you could load the resulting files into the database, but this is regularly not a good idea. It is better to store the files in a structured way in a file system and to include the paths of these files in your database in connection with the ID of the process.

I was hoping there would be an easy way to just use insert into to insert an object (MyMail) as an attachment. But it looks, based on what you're saying, I'll need to save the incoming email as a file on the HD and then from there import it into the correct record on the table using the ID.

I've put together this code for that purpose:

Sub Application_ItemAdd(ByVal Item As Object, Cancel As Boolean)
    Call SaveACopy(Item)
End Sub

Sub SaveACopy(Item As Object)
    Const olMsg As Long = 3
    Dim MyMail As MailItem
    Dim SPath As String

    If TypeName(Item) <> "MailItem" Then Exit Sub
    Set MyMail = Item
    SPath = "\\page\data\NFInventory\groups\CID\CID Database\Attachment\attachment.msg"
    MyMail.SaveAs SPath, olMsg
End Sub

But the Application_ItemAdd isn't being recognized as new emails come into the inbox. Also I think there should be a way to accomplish the above code and drop it into my current code:

Sub Application_NewMailEx(ByVal EntryIDCollection As String)
On Error Resume Next


'Mail Definitions
Dim MyMail As MailItem
Set MyMail = Application.Session.GetItemFromID(EntryIDCollection)


Dim MSub As String, MSender As String, MBody As String, Mtime As Date


MSub = MyMail.Subject
MSender = MyMail.Sender
MBody = MyMail.Body
Mtime = MyMail.ReceivedTime


If (MSub Like "*Proof*") Or (MSender Like "*message@adobe.com*") Then
'INSERT Query
Dim str As String
str = "INSERT INTO ITtbl ([From], [Subject], [Body], [Received]) VALUES (" & "'" & MSender & "'" & ", " & "'" & MSub & "'" & ", " & "'" & MBody & "'" & ", " & "'" & Mtime & "'" & ")"


'Access Connection
Dim cnx As ADODB.Connection
Set cnx = New ADODB.Connection


cnx.Provider = "Microsoft.ACE.OLEDB.12.0"
cnx.ConnectionString = "\\page\data\NFInventory\groups\CID\CID Database\Test Database\dbBE\CID_be.accdb"
cnx.Open
cnx.Execute str
Else
End If
    
End Sub

I've tried a few things where I set Item as Object and a new Mitem as MailItem then defining each with a set statement. But I either get compile errors or nothing happens. Do you have any suggestions on condensing these to make it work?

appreciate the responses and help so far!

 

[MarkK]

Your routine SaveACopy has an Outlook.MailItem, and it knows the path where the file is saved. So get that routine to call the routine that saves the data to the table. Pass in the MailItem, and the path to the file.

 

[MarkK]

But I am not certain that saving the MailItem as a .MSG file preserves the attachments the MailItem may contain. Have you tested that?

 

[Deke]

Your routine SaveACopy has an Outlook.MailItem, and it knows the path where the file is saved. So get that routine to call the routine that saves the data to the table. Pass in the MailItem, and the path to the file.

I'm getting a lot of compile errors when I attempt this. Either I'm getting Argument not optional or procedure declaration does not match description of event or procedure of the same name.

I'm guessing it has to do with the attempt to use the Application_NewMailEx in order to identify new emails coming in? But I don't understand why this won't work. I've also tried to just use a standard sub name, that's when I get the argument not optional error.

Code I was trying was this:

Sub Application_NewMailEx(Item As Object)
    Const olMsg As Long = 3


    Dim m As MailItem
    Dim savePath As String


    If TypeName(Item) <> "MailItem" Then Exit Sub


    Set m = Item


    savePath = "c:\users\your_user_name\desktop\"  '## Modify as needed
    savePath = savePath & m.Subject & Format(Now(), "yyyy-mm-dd-hhNNss")
    savePath = savePath & ".msg"


    m.SaveAs savePath, olMsg
    
Call ProofMail
    
End Sub

Sub ProofMail(ByVal EntryIDCollection As String)
On Error Resume Next


'Mail Definitions
Dim MyMail As MailItem
Set MyMail = Application.Session.GetItemFromID(EntryIDCollection)


Dim MSub As String, MSender As String, MBody As String, Mtime As Date


MSub = MyMail.Subject
MSender = MyMail.Sender
MBody = MyMail.Body
Mtime = MyMail.ReceivedTime


Call Mattach(Object, Cancel)


If (MSub Like "*Proof*") Or (MSender Like "*message@adobe.com*") Then
'INSERT Query
Dim str As String
str = "INSERT INTO ITtbl ([From], [Subject], [Body], [Received]) VALUES (" & "'" & MSender & "'" & ", " & "'" & MSub & "'" & ", " & "'" & MBody & "'" & ", " & "'" & Mtime & "'" & ")"


'Access Connection
Dim cnx As ADODB.Connection
Set cnx = New ADODB.Connection


cnx.Provider = "Microsoft.ACE.OLEDB.12.0"
cnx.ConnectionString = "\\page\data\NFInventory\groups\CID\CID Database\Test Database\dbBE\CID_be.accdb"
cnx.Open
cnx.Execute str
Else
End If
    
End Sub

 

[Deke]

Okay figured it out. Wow was I overthinking it.
Okay My next step is getting the .msg file imported into the correct record in the db table.
Does anyone have any resources for this? I'll be researching how to do this shortly but figured I'd ask anyway.

Thanks again for the help!