Downloading attachments

lonesoac0 · #1 05-19-2016, 04:48 PM

Hello all,

I found the site of: http://www.slipstick.com/developer/s...he-hard-drive/ and I am interested in cobbeling parts of the article into a usable process. What I want is for emails from a specific user with a specific attachment to be automatically downloaded to a folder. All of the code is there, I just cannot piece it all together. I got the first part to work on my own and I get the feeling that the sections following the first are just plug and play. I have no idea where to plug them into where in the first part of the section.

Any assistance would be greatly appreciated.

gmayor · #2 05-19-2016, 09:55 PM

This is fairly straightforward, and can be done with a script attached to a rule that identifies the incoming messages by sender, but your question raises an important issue.

You indicate that you are wanting to download a particular attachment. Will that attachment always have the same name? If it does (or if it has the same name as a file already in the target folder) what do you want to do about the name clash. Do you wish to overwrite the existing file or preserve it?

The following when run from the aforesaid rule will extract all attachments to the named folder which must exist, Existing files are retained.

Code:

Public Sub SaveAttachments(olItem As MailItem)
'An Outlook macro by Graham Mayor
Dim olAttach As Attachment
Dim strFname As String
Dim strExt As String
Dim j As Long
'The folder to save the attachments
'This folder must exist
Const strSaveFldr As String = "C:\Path\Reports\"

    On Error GoTo CleanUp
    If olItem.Attachments.Count > 0 Then
        For j = olItem.Attachments.Count To 1 Step -1
            Set olAttach = olItem.Attachments(j)
            If Not olAttach.FileName Like "image*.*" Then
                strFname = olAttach.FileName
                strExt = Right(strFname, Len(strFname) - InStrRev(strFname, Chr(46)))
                strFname = FileNameUnique(strSaveFldr, strFname, strExt)
                olAttach.SaveAsFile strSaveFldr & strFname
                'olAttach.Delete        'delete the attachment
            End If
        Next j
        olItem.Save
    End If
CleanUp:
    Set olAttach = Nothing
    Set olItem = Nothing
lbl_Exit:
    Exit Sub
End Sub

Private Function FileNameUnique(strPath As String, _
                                strFileName As String, _
                                strExtension As String) As String
'An Outlook macro by Graham Mayor
Dim lngF As Long
Dim lngName As Long
    lngF = 1
    lngName = Len(strFileName) - (Len(strExtension) + 1)
    strFileName = Left(strFileName, lngName)
    Do While FileExists(strPath & strFileName & Chr(46) & strExtension) = True
        strFileName = Left(strFileName, lngName) & "(" & lngF & ")"
        lngF = lngF + 1
    Loop
    FileNameUnique = strFileName & Chr(46) & strExtension
lbl_Exit:
    Exit Function
End Function

Private Function FileExists(filespec) As Boolean
'An Outlook macro by Graham Mayor
Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    If fso.FileExists(filespec) Then
        FileExists = True
    Else
        FileExists = False
    End If
lbl_Exit:
    Exit Function
End Function

lonesoac0 · #3 05-20-2016, 04:49 AM

You sir, are flippin' awesome. The attachments will always have different names. If the file names are the same then just prepend a 1_ to it.

UPDATE: I tried to create a rule to run the code you gave me, but I am not finding it in the Script dialog box. I checked https://support.microsoft.com/en-us/kb/306108 and the code looks really similar to what you gave me. What gives?

gmayor · #4 05-20-2016, 06:44 AM

The code should be in an ordinary module and not ThisOutlookSession and there must not be another macro with the same name in the project. Outlook can be fussy with macro code. You will probably need to digitally sign the project for the code to work - see http://www.gmayor.com/create_and_emp...gital_cert.htm

The code adds (1), (2) etc to the filename if it exists in the target location.

lonesoac0 · #5 05-20-2016, 11:21 AM

I got to using the program that you helped me build and I have decided if the file is the same then I want it to skip over that file. How can I do that?

gmayor · #6 05-20-2016, 08:45 PM

In that case change the following

Code:

For j = olItem.Attachments.Count To 1 Step -1
            Set olAttach = olItem.Attachments(j)
            If Not olAttach.FileName Like "image*.*" Then
                strFname = olAttach.FileName
                strExt = Right(strFname, Len(strFname) - InStrRev(strFname, Chr(46)))
                'strFname = FileNameUnique(strSaveFldr, strFname, strExt)
                If Not FileExists(strSaveFldr & strFname) Then
                    olAttach.SaveAsFile strSaveFldr & strFname
                End If
                'olAttach.Delete        'delete the attachment
            End If
        Next j

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Shortcut for downloading attachments in e-mail	paik1002	Outlook	4	12-11-2015 03:01 AM
emails in Outlook not downloading	Jeff Peterson	Outlook	0	05-08-2013 10:25 PM
Downloading & saving templates for my son	msaylor	Word	2	05-29-2012 05:00 PM
Downloading Office 2007	whynot	Office	4	01-05-2011 02:25 PM
Problem downloading	Tiffany	Office	0	11-06-2005 09:26 PM