Extract Email Attachment into MS database

[Adict]

I am working on simple task monitoring tool build in MS Access 2016. I have link the outlook inbox into my access db. but I am only getting text, I am looking hit how I could get attachment from the emails into the db as well.

Is it possible to do this through vba? I have wrote this code but its not working as intended. Any help will be greatly appreciated.

Private Sub GetAttachments()
 
    Dim ns As Namespace
    Dim Inbox As Outlook.MAPIFolder
    Dim Item As Object
    Dim Atmt As Outlook.Attachment
    Dim FileName As String
 
    Set ns = GetNamespace("MAPI")
 
    Set Inbox = ns.GetDefaultFolder(olFolderInbox)
    Set Inbox = ns.Folders("MailboxName").Folders("Inbox")
 
    If Inbox.Items.Count = 0 Then
        MsgBox "There are no messages in the Inbox.", vbInformation, _
                "Nothing Found"
        Exit Sub
    End If
 
    For Each Item In Inbox.Items
        For Each Atmt In Item.Attachments
            If Atmt.Type = 1 And InStr(Atmt, "xlsx") > 0 Then
                FileName = "C:\attachments\" & Atmt.FileName
                Atmt.SaveAsFile FileName
            End If
        Next Atmt
    Next Item
 
End Sub
 

[NeoPa]

Adict:
not working as intended

Not sure that's very helpful if I'm honest.

Bear in mind we aren't at your computer and only have what you tell us to go in. So, not much then.

What happens? Where does it break? How does it break?

[Adict]

So the code above runs well but its looking at all the emails in the outlook folder and extracting emails, what i need is something like every email received gets registered into my internal table called Inbox with the rest of the text and attachment from that single email. Search much but didn't come across any . appreciate if i can be pointed to right direction

[zmbd]

Adict,
1) Rarely a good idea to store files in an access database. The file size of the database is fairly small and the bloat is horrendous.

2) You have no reference to the database in your code.

3) Your follow-up is still a bit obscure, maybe it's the late hour/long day I have had?
Perhaps, try to explain what you want in a step by step fashion?

4) Are you running this code from Outlook or from Access?

[Adict]

Thank you, i wish to run the code from my access database.
1. I have link the particular outlook mail box into my database but i only get text which since into my table called email.

2. What i intend to achieve is to extract outlook attachment into each records with a click event from Access Database.

3.Extract the specific email into a shared network folder and have the link inserted into my table.

Thanks in advance

[NeoPa]

NeoPa:
What happens? Where does it break? How does it break?

Sorry. Let's try again.

I'm happy you're described what you want from the code. I'm also happy you've started the code already and posted what you have. All good. I'm less happy that you haven't explained what's actually happening when you try to run it.

I hope it's now very clear what it is I'm asking for.

PS. I agree with Zmbd about the advisability of storing files in a database. Even in bigger ones (than Access) it's a something that would need careful consideration. Nevertheless, it never hurts to learn how to do things. Your judgement as to what you use when you know how is up to you. We're here to help you to know how.

[zmbd]

1. I have link the particular outlook mail box into my database but i only get text which since into my table called email.

Did you create this link by:
Ribbon>External Data>Import & Link/More>Outlook Folder
(x)Link to the data source....

The problem with this method is that there is typically no message_id field which will make it difficult to associate any attachments with the corresponding email.

[ADezii]

If you wish to avoid and Link and save the Attached Files to a Folder on your Hard Drive, the following Code will work well (assuming you have a Folder named 'C:\Attachments'). You could then simply store the PATH to these Files within your DB.

Dim ns As Outlook.Namespace
Dim appOutlook As Outlook.Application
Dim Inbox As Outlook.MAPIFolder
Dim Item As Outlook.MailItem
Dim Atmt As Outlook.Attachment
Dim FileName As String
 
Set appOutlook = New Outlook.Application
Set ns = appOutlook.GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(olFolderInbox)
 
If Inbox.Items.Count = 0 Then
  MsgBox "There are no messages in the Inbox.", vbInformation, _
         "Nothing Found"
    Exit Sub
End If
 
For Each Item In Inbox.Items
  For Each Atmt In Item.Attachments
    If Atmt.Type = 1 And InStr(Atmt, "xlsx") > 0 Then
      FileName = "C:\attachments\" & Atmt.FileName
        Atmt.SaveAsFile FileName
    End If
  Next
Next Item

[zmbd]

ADezii,
Essentially where I was going with this...

My thought was:
Table with the email text information
Table with a [FK] to the email table with would store the path information for the saved attachments to handle emails with multiple attachments.

[Adict]

Thanks Zmdb, I did try that by inserting a code on the outlook to run a insert function when a new mail arrived into the Inbox. However it didn't run as intended. Here the code i wrote in outlook that I ended up getting error with

Dim HRSWorkflow As MailItem
Set HRSWorkflow = Application.Session.GetRecipientFromID(EntryIDCollection)
 
Dim WkfSubject As String, WkfSender As String, wrfSenderEmail As String, wkfrequestdate As Date, wkfdescription As String, wkfcc As String
 
 
WkfSender = HRSWorkflow.Sender
wrfSenderEmail = HRSWorkflow.SenderEmailAddress
WkfSubject = HRSWorkflow.Subject
wkfcc = HRSWorkflow.CC
wkfrequestdate = HRSWorkflow.ReceivedTime
wkfdescription = HRSWorkflow.Body
'_______________________________________________________________
Dim str As String
 
str = "INSERT INTO TABLE tblTaskCollector(Sender,SenderEmail,Subject, CC,Description,DateRecieved) VALUES(" & "'" & WkfSender & "'" & "," & "'" & wrfSenderEmail & "'" & "," & "'" & WkfSubjec & "'" & "," & "'" & wkfcc & "'" & "," & "'" & wkfrequestdate & "'" & "," & "'" & wkfdescription & "'" & ", )"
Dim cnx As ADODB.Connection
Set cnx = New ADODB.Connection
 
cnx.Provider = "Microsoft.ACE.OLEDB.12.0"
cnx.ConnectionString = "C:\Users\PosiaE\Documents\HR Transacts.accdb"
cnx.Open
cnx.Execute (str)

[Adict]

How can i get a unique id to identify this attachment belong to this email? Apology, I ma having my head cracked by this. Really appreciate all your feedback.

[ADezii]

1. In line with zmbd's Post #9, I am making some assumptions here strictly to illustrate a point. These assumptions are:
2. You have a Table named tblAttachments with two Fields ([FK]-{TEXT}, [FPath]-{TEXT}). [FK] is a Foreign Key Field and relates to a Primary Key Field in a MASTER Table.
3. The Foreign Key Value can somehow be derived from the E-Mail. In this case, I simply used the first six characters of the Subject Line as the Foreign Key.
4. The above being said, the following Code will:
   1. Process every E-Mail in the Inbox Folder.
   2. If the first 6 characters of the Subject Line is Numeric ([FK]) AND it was Sent after yesterday (5/12/2019) then we loop thru all Attachments in that E-Mail with a *.xlsx Extension.
   3. The Foreign Key is written to the [FK] Field in tblAttachments and the Absolute Path (Filename] is written to the [FPath] Field in tblAttachments.
   4. The actual Attachment(s) is/are saved to the Filename Path.
5. Code Definition:
   

   Dim ns As Outlook.Namespace
   Dim appOutlook As Outlook.Application
   Dim Inbox As Outlook.MAPIFolder
   Dim Item As Outlook.MailItem
   Dim Atmt As Outlook.Attachment
   Dim FileName As String
    
   Set appOutlook = New Outlook.Application
   Set ns = appOutlook.GetNamespace("MAPI")
   Set Inbox = ns.GetDefaultFolder(olFolderInbox)
    
   DoCmd.Hourglass True
    
   If Inbox.Items.Count = 0 Then
     MsgBox "There are no messages in the Inbox.", vbInformation, _
            "Nothing Found"
       Exit Sub
   End If
    
   For Each Item In Inbox.Items
     If IsNumeric(Left$(Item.Subject, "6")) And Item.SentOn > #5/12/2019# Then
       For Each Atmt In Item.Attachments
         If Atmt.Type = 1 And InStr(Atmt, ".xls") > 0 Then
           FileName = "C:\attachments\" & Atmt.FileName
             CurrentDb.Execute "INSERT INTO tblAttachments ([FK], [FPath]) VALUES ('" & _
                                Left$(Item.Subject, "6") & "','" & FileName & "')", _
                                dbFailOnError
               Atmt.SaveAsFile FileName
          End If
       Next
      End If
   Next Item
    

6. The Code has been tested and is fully operational under certain conditions. The only problem that I see is that this should all be wrapped in some form of Transaction since you would not want tblAttachments being updated and the SaveAsFile operation fail.

P.S. - If you wish to execute similar Code from Outlook when the E-Mails first arrive, then we are talking about a totally different situation.