VBA - Outlook - 保存附件

Question

I am receiving e-mails from two vendors. From both vendors - the e-mails have two types of attachments attached - 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 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 my script to save only XML files, depending on the type, to one of three different folders, however my script works only for Vendor B, and not for Vendor A.

I assume my problem is, that my script search 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

Would you be able to help me?

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