[X]My Assistant

[MisterChips]

I have Office 365.
I would like to be able, upon the receipt of an email with a specifically named attachment, to have that file automatically saved.

I have found the following code which i have been unable to make work.

CODE

Option Explicit

Public WithEvents olItems As Outlook.Items

Private Sub Application_Startup()
    Set olItems = Session.GetDefaultFolder(olFolderInbox).Items
    olItems_ItemAdd
End Sub

Private Sub olItems_ItemAdd(ByVal Item As Object)
    Dim NewMail As Outlook.MailItem
    Dim Atts As Attachments
    Dim Att As Attachment
    Dim strPath As String
    Dim strName As String

    If Item.Class = olMail Then
       Set NewMail = Item
    End If

    Set Atts = Item.Attachments

    If Atts.Count > 0 Then
       For Each Att In Atts
           'Replace "test" with what you want to look for in attachment name
           If InStr(LCase(Att.FileName), "TAFC_Bulk_Emailing_Data") > 0 Then
              'Use your wanted destination folder path to save the attachments
              strPath = "C:\users\dave\desktop\"
              strName = NewMail.Subject & " " & Chr(45) & " " & Att.FileName
              Att.SaveAsFile strPath & strName
           End If
       Next
    End If
End Sub

I have used SELFCERT to self certify the code, which I believe I have to do, which i think that I have done correctly.

I do not know whether this code is designed to work :-
a. Automatically, as the email is received
b. After the email is opened
c. after firing up Outlook.

Whatever, I am unable to get the code to save the file.

Are you able to assist please?
This post has been edited by MisterChips: Feb 11 2019, 11:06 AM

[ADezii]

1. The following Code will:
   
   1. Open all E-Mails in the User's Inbox.
   2. If the E-Mail contains at least one Attachment, loop thru all the Attachments for that E-Mail, and if the Filename contains a specific String within it, Save that Attachment to Disk.
   3. Change the Value of the User defined Constant conSAVE_PATH and modify the Code to suite your specific needs.
2. Code definition:
   
   CODE
   Dim myOlApp As New Outlook.Application
   Dim myOlItems As Outlook.Items
   Dim msg As Outlook.MailItem
   Dim objNS As Outlook.NameSpace
   Dim oFT As Outlook.MAPIFolder
   Dim oAttch As Outlook.Attachment
   Const conSAVE_PATH = "C:\Test\"      'USER DEFINED
   
   'Set Outlook Folders to use
   Set objNS = myOlApp.GetNamespace("MAPI")
   Set oFT = objNS.GetDefaultFolder(olFolderInbox)    'My inbox
   Set myOlItems = myOlApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Items
   
   DoCmd.Hourglass True
   
   Set msg = oFT.Items(1)
   
   For Each msg In myOlItems
     Select Case TypeName(msg)
       Case Is = "MailItem"
         If msg.Attachments.Count > 0 Then
           For Each oAttch In msg.Attachments
             If InStr(oAttch.FileName, "TAFC_Bulk_Emailing_Data") > 0 Then
               oAttch.SaveAsFile conSAVE_PATH & msg.Subject & " " & Chr(45) & _
                                 " " & oAttch.FileName
             End If
           Next
         End If
       Case Else
         'Covers all other contingencies
     End Select
     msg.Save
   Next msg
   
   Set msg = Nothing
   Set myOlApp = Nothing
   Set objNS = Nothing
   Set oFT = Nothing

P.S. - Uses Early Binding.
This post has been edited by ADezii: Feb 11 2019, 01:09 PM

[cheekybuddha]

@ADezii,

This looks like the code should reside in Access rather than Outlook. It might need some adjusting to run in Outlook (probably just remove a load of object variables)

d

[ADezii]

@cheekybuddha:
Thanks, totally missed that point!

[ADezii]

You can also consider using the Outlook Application's NewMail() Event which fires when new Messages arrive in the Inbox and before Client Rule processing occurs.