Saving attachments with specified text found in file name

Question

I receive e-mails, from two vendors, that have two types of attachments, with extension of xml and pdf.
XML can contain data of three types, which is reflected in the name of the XML file.
The types of XML let's say can be: "IE529", "IE599", "ZC299".

XMLs from Vendor "A" are named like this: (...)ZC299(...).xml

XMLs from Vendor "B" are named like this: ZC299 (...).xml --> there is space here.

I want to save only XML files, depending on the type, to one of three folders, however my script works only for Vendor B.

I assume my problem is, that my script searches for separate name "ZC299", but doesn't recognize it when it is hidden in the middle of filename.

Public Sub Komunikaty(MItem As Outlook.MailItem)

Dim Zalacznik As Outlook.Attachment
Dim KatalogIE529 As String
Dim KatalogIE599 As String
Dim KatalogZC299 As String

KatalogIE529 = "C:(...)"
KatalogIE599 = "C:(...)"
KatalogZC299 = "C:(...)"

For Each Zalacznik In MItem.Attachments

    If InStr(1, Zalacznik.DisplayName, "IE529", vbTextCompare) And InStr(1, Zalacznik.DisplayName, ".xml", vbTextCompare) Then
        Zalacznik.SaveAsFile KatalogIE529 & "\" & Zalacznik.DisplayName
    
    ElseIf InStr(1, Zalacznik.DisplayName, "IE599", vbTextCompare) And InStr(1, Zalacznik.DisplayName, ".xml", vbTextCompare) Then
        Zalacznik.SaveAsFile KatalogIE599 & "\" & Zalacznik.DisplayName

    ElseIf InStr(1, Zalacznik.DisplayName, "ZC299", vbTextCompare) And InStr(1, Zalacznik.DisplayName, ".xml", vbTextCompare) Then
        Zalacznik.SaveAsFile KatalogZC299 & "\" & Zalacznik.DisplayName

    End If

Next

End Sub

Answer 1

The code is valid. The InStr function returns a long specifying the position of the first occurrence of one string within another.

Try to set a breakpoint and see what results you are getting when the attachment display name contains a different string. Just run the code line-by-line and you will find the cause.

Also you may consider using regular expressions to find a match, see How to use Regular Expressions (Regex) in Microsoft Excel both in-cell and loops for more information how to use them in VBA.

Answer 2

I would look to do a number of tests on the DisplayName then use some arrays to access the correct save locations. Your code seems to be somewhat incomplete as not all vendor save places seem to be present, so some extrapolation done.

Please note this is untested, and some debugging with the Array() assignment probably needed

Public Sub Komunikaty(MItem As Outlook.MailItem)

    Dim Zalacznik As Outlook.Attachment, Vendor As String, i As Long

    Dim KatalogIE529 As String: KatalogIE529 = "C:(...)"
    Dim KatalogIE599 As String: KatalogIE599 = "C:(...)"
    Dim KatalogZC299 As String: KatalogZC299 = "C:(...)"
    Dim Name As String
    
    Dim TextArr() As String: TextArr = Split("IE529", "IE599", "ZC299")
    Dim SaveArrA() As String: SaveArrA = Array(KatalogIE529, KatalogIE599, KatalogZC299)
    Dim SaveArrB() As String: SaveArrB = Array(KatalogIE529, KatalogIE599, KatalogZC299)
    
    For Each Zalacznik In MItem.Attachments
        Name = UCase(Zalacznik.DisplayName)
        If Right(Name, 4) = ".XML" Then 
            For i = LBound(TextArr) To UBound(TextArr)
                Select Case InStr(Name, Arr(i))
                    Case Is = 1
                        Zalacznik.SaveAsFile SaveArrA(i) & "\" & Zalacznik.DisplayName
                    Case Is > 1
                        Zalacznik.SaveAsFile SaveArrB(i) & "\" & Zalacznik.DisplayName
                    Case Default
                End Select
            Next i
        End If
    Next

End Sub