Why does a saved attachment's file name include the name of the expected save folder?

Question

I'm trying to:

1. Check the email for attachments

2. If the email contains an attachment cycle through the method for each attachment in the email.

3. The method will search the attachment display name for a string match anywhere in the name, and assign it an ID accordingly

4. It will then save a copy of the attachment to the matching subfolder based on the ID if the attachment is a .pdf

Issues I'm running into:

• InStr doesn't seem to be assigning id's properly

• The macro is saving copies of the attachment, but it's renaming them to the file folder name, and doesn't seem to be sorting based on id.

• Once copies are saved, the only way I can delete them is through the cmd.

---

Public Sub ProcessEmails()

Dim oItems As Outlook.Items
Dim oItem As Object

Set oItems = Session.GetDefaultFolder(olFolderInbox).Items

For Each oItem In oItems
    If TypeName(oItem) = "MailItem" Then Call SaveAttachmentsToDisk(oItem)
Next oItem

End Sub



Private Sub SaveAttachmentsToDisk(oItem As Outlook.MailItem)

'Declares objAtt as an outlook attachment
Dim objAtt As Attachment
'Declares i as data type Integer
Dim i As Integer
'Declares objFSO as any Data Type
Dim objFSO As Object
'Declares sExt as data type string
Dim sExt As String
'Declares sSaveFolder as data Type string
Dim sSaveFolder As String

'Only proceed if the email contains attachements.
If oItem.Attachments.Count > 0 Then
    Set objFSO = CreateObject("Scripting.FileSystemObject")


    'Cycle through each attachment on the email.
    For i = 1 To oItem.Attachments.Count
        Set objAtt = oItem.Attachments(i)

       'Get the extension of the attached file name.
        sExt = objFSO.GetExtensionName(objAtt.FileName)

        'declares an Id used for file path routing
        Dim id As Integer

        'Checks the email attachment name for a string match. If a match occurs, assigns an ID used for file path routing
        Select Case True

        Case InStr(1, objAtt.DisplayName, "APP", vbTextCompare) > 0
            id = "1"
        Case InStr(1, objAtt.DisplayName, "B2B - Asset", vbTextCompare) > 0
            id = "2"
        Case InStr(1, objAtt.DisplayName, "B2B - Business", vbTextCompare) > 0
            id = "3"
        Case InStr(1, objAtt.DisplayName, "B2B Fair", vbTextCompare) > 0
            id = "4"
        Case InStr(1, objAtt.DisplayName, "BDL", vbTextCompare) > 0
            id = "5"
        Case Else

        End Select


        'Saves outlook attachment to 'sSaveFolder' declared path if file extension is 'pdf'
        If sExt = "pdf" Then
            'Saves attachment to related subfolder based on ID
            Select Case id
                Case "1"
                    sSaveFolder = "C:\Users\jkassels\Desktop\test\test1"
                Case "2"
                    sSaveFolder = "C:\Users\jkassels\Desktop\test\test2"
                Case "3"
                    sSaveFolder = "C:\Users\jkassels\Desktop\test\test3"
                Case "4"
                    sSaveFolder = "C:\Users\jkassels\Desktop\test\test4"
                Case "5"
                    sSaveFolder = "C:\Users\jkassels\Desktop\test\test5"
                Case Else
                    sSaveFolder = "C:\Users\jkassels\Desktop\test"
            End Select

            objAtt.SaveAsFile sSaveFolder & objAtt.DisplayName
        End If


        Set objAtt = Nothing
    Next i
    Set objFSO = Nothing
End If
End Sub

Answer 1

I've made quite a few changes to your code to clean up some things:

• I removed id, as it seems to serve no purpose. Why not just skip the assignment of id and go right to assigning the save paths?

• I've also moved all declarations to the top, as you shouldn't be using
  Dim inside a loop.

• I've removed a lot of the comments - comments should be reserved for making clarifications where confusion can occur - no need to explain that all your Dim lines are declarations, and what they're being declared as. If anything, just start that snippet with 'Declarations if you feel the need to.

Also, Select Case is great - but you can't use Select Case to evaluate True. In your scenario, and If/ElseIf statement will suffice:

Public Sub ProcessEmails()

Dim oItems As Outlook.Items
Dim oItem As Object

Set oItems = Session.GetDefaultFolder(olFolderInbox).Items

For Each oItem In oItems
    If TypeName(oItem) = "MailItem" Then Call SaveAttachmentsToDisk(oItem)
Next oItem

End Sub

Private Sub SaveAttachmentsToDisk(oItem As Outlook.MailItem)

Dim objAtt As Attachment
Dim i As Integer
Dim objFSO As Object
Dim sExt As String
Dim sSaveFolder As String

'Only proceed if the email contains attachements.
If oItem.Attachments.Count > 0 Then

    Set objFSO = CreateObject("Scripting.FileSystemObject")

    For i = 1 To oItem.Attachments.Count
        Set objAtt = oItem.Attachments(i)

        sExt = objFSO.GetExtensionName(objAtt.Filename)

        If sExt = "pdf" Then
            If InStr(1, objAtt.DisplayName, "APP", vbTextCompare) > 0 Then
                sSaveFolder = "C:\Users\jkassels\Desktop\test\test1\"
            ElseIf InStr(1, objAtt.DisplayName, "B2B - Asset", vbTextCompare) > 0 Then
                sSaveFolder = "C:\Users\jkassels\Desktop\test\test2\"
            ElseIf InStr(1, objAtt.DisplayName, "B2B - Business", vbTextCompare) > 0 Then
                sSaveFolder = "C:\Users\jkassels\Desktop\test\test3\"
            ElseIf InStr(1, objAtt.DisplayName, "B2B Fair", vbTextCompare) > 0 Then
                sSaveFolder = "C:\Users\jkassels\Desktop\test\test4\"
            ElseIf InStr(1, objAtt.DisplayName, "BDL", vbTextCompare) > 0 Then
                sSaveFolder = "C:\Users\jkassels\Desktop\test\test5\"
            Else
                sSaveFolder = "C:\Users\jkassels\Desktop\test\"
            End If

            objAtt.SaveAsFile sSaveFolder & objAtt.DisplayName
        End If

        Set objAtt = Nothing
    Next i

    Set objFSO = Nothing

End If

End Sub