Rename attachment and save

Question

I have emails with pdf attachments I would like to save automatically as they come into my inbox. I have my code mostly written, I have tested that all the variables have the correct value, and they output the correct data; however, I'm not sure how to code the actual saving of the file.

The file will get renamed to the customer's address, which is extracted with my code below:

Sub EagleViewSaveAttachment()

    'Define Variables
    Dim sFileName As String
    Dim varAddress As Variant
    Dim City As Variant
    Dim fdObj As Object
    Dim NextFriday As Date
    Dim JobArea As String
    Dim JobCity As Variant
    Dim myPath As String
    Dim objAtt As Outlook.Attachment
    Dim myFinalPath As String

    'Set Variables
    NextFriday = Date + 8 - Weekday(Date, vbFriday)
    myPath = "C:\Users\admin\OneDrive\Documents\EagleView\"

    Set myfolder = Outlook.ActiveExplorer.CurrentFolder
    Set fdObj = CreateObject("Scripting.FileSystemObject")

    'Loop through emails in folder
    For i = 1 To myfolder.Items.Count
        Set myitem = myfolder.Items(i)
        msgtext = myitem.Body

        'Search for Specific Text
        delimitedMessage = Replace(msgtext, "Address: ", "###")
        delimitedMessage = Replace(delimitedMessage, ",", "###")
        varAddress = Split(delimitedMessage, "###")

        'Assign the job address from email to variable
        sFileName = varAddress(10)
        JobCity = LTrim(varAddress(11))

        'Define office area based on job city

        If JobCity = "Panama City" Or JobCity = "Mexico Beach" Or JobCity = "Panama City Beach" Or JobCity = "Lynn Haven" Or JobCity = "Port Saint Joe" Then
            JobArea = "Panama"
        ElseIf JobCity = "Daytona Beach" Or JobCity = "Port Orange" Or JobCity = "Deltona" Or JobCity = "Ormond Beach" Or JobCity = "Deland" Then
            JobArea = "Daytona"
        ElseIf JobCity = "Orlando" Then
            JobArea = "Orlando"
        ElseIf JobCity = "Jacksonville" Then
            JobAre = "Jacksonville"
        Else
            JobArea = LTrim(varAddress(11))
        End If

        'Define Final Path
        myFinalPath = myPath + Format$(NextFriday, "yyyy-mm-dd") + "\" + JobArea + "\"

        'Check if the path exists, if not create it
        If fdObj.FolderExists(myFinalPath) Then
            MsgBox "Found it."
        Else
            fdObj.CreateFolder (myFinalPath)
            MsgBox "It has been created."
        End If

    Next

End Sub

As of right now, what I am unable to do is get it to check if the directory C:\Users\admin\OneDrive\Documents\EagleView\yyyy-mm-dd\JobArea already exists and to create it if it doesn't already exist.

I'm fairly certain the problem lies in my usage of fdObj.FolderExists(myFinalPath) as it seems that doesn't accept variables.

This solution doesn't seem to work for me as when I change it to Dir(myFinalPath, vbDirectory)= "", it returns saying "Found it." when I know the folder doesn't exist yet. — Mike, Dec 11 '18 at 21:33
What actually happens when your code runs? You need something a little more complex if it's not just the last folder in the path which is missing - `CreateFolder` only creates one level: it will not create (eg) a missing parent folder. https://stackoverflow.com/questions/4407386/help-to-create-folder1-folder2-in-windows-using-vbscript-both-the-folders-not — Tim Williams, Dec 11 '18 at 22:00
Add `Debug.Print myFinalPath` right before the `If` statement. Is the path exactly as you expect it? (To see the debug output, open the Immediate Window with CTRL+G in the VBEditor). I just tried your code and it works correctly for me. — BruceWayne, Dec 12 '18 at 03:14

score 0 · Answer 1 · answered Dec 12 '18 at 06:21

According to my search, fdObj.FolderExists() can accept variables, like this:

Sub Test_File_Exist_FSO_Early_binding()
'If you want to use the Intellisense help showing you the properties
'and methods of the objects as you type you can use Early binding.
'Add a reference to "Microsoft Scripting Runtime" in the VBA editor
'(Tools>References)if you want that.

    Dim FSO As Scripting.FileSystemObject
    Dim FilePath As String

    Set FSO = New Scripting.FileSystemObject

    FilePath = "C:\Users\Ron\test\book1.xlsm"

    If FSO.FileExists(FilePath) = False Then
        MsgBox "File doesn't exist"
    Else
        MsgBox "File exist"
    End If

End Sub

Reference from:

Test if Folder, File or Sheet exists or File is open

You could save and rename attachment refer to the below link:

Save attachments to a folder and rename them

score 0 · Accepted Answer · answered Dec 12 '18 at 06:22

Use function like this

Private Function CreateDir(FldrPath As String)
    Dim Elm As Variant
    Dim CheckPath As String

    CheckPath = ""
    For Each Elm In Split(FldrPath, "\")
        CheckPath = CheckPath & Elm & "\"

        If Len(Dir(CheckPath, vbDirectory)) = 0 Then
            MkDir CheckPath
            Debug.Print CheckPath & " Folder Created"
        End If

        Debug.Print CheckPath & " Folder Exist"
    Next
End Function

then call it

Example

    'Define Final Path
    myFinalPath = myPath + Format$(NextFriday, "yyyy-mm-dd") + "\" + JobArea + "\"

    CreateDir myFinalPath ' <--- call call function

Rename attachment and save

2 Answers2