X   Site Message
(Message will auto close in 2 seconds)

Welcome to UtterAccess! Please ( Login   or   Register )

Custom Search
   Reply to this topicStart new topic
> Saving Specifically Named Attachments To File, Any Version    
post Feb 11 2019, 11:00 AM

Posts: 68
Joined: 29-January 17

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.
Option Explicit

Public WithEvents olItems As Outlook.Items

Private Sub Application_Startup()
    Set olItems = Session.GetDefaultFolder(olFolderInbox).Items
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
    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
Go to the top of the page
post Feb 11 2019, 01:08 PM

Posts: 2,807
Joined: 4-February 07
From: USA, Florida, Delray Beach

  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:
    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
          End If
        Case Else
          'Covers all other contingencies
      End Select
    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
Go to the top of the page
post Feb 11 2019, 01:34 PM

UtterAccess Moderator
Posts: 12,603
Joined: 6-December 03
From: Telegraph Hill


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)




David Marten
Go to the top of the page
post Feb 11 2019, 03:18 PM

Posts: 2,807
Joined: 4-February 07
From: USA, Florida, Delray Beach

Thanks, totally missed that point!
Go to the top of the page
post Feb 11 2019, 04:30 PM

Posts: 2,807
Joined: 4-February 07
From: USA, Florida, Delray Beach

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.
Go to the top of the page

Custom Search

RSSSearch   Top   Lo-Fi    28th March 2020 - 06:31 PM