按文件名指定文本筛选并保存Outlook邮件XML附件问题

我接收供应商A和B的邮件，附件包含XML和PDF两种类型。其中XML附件分为三类：IE529、IE599、ZC299，类型标识体现在文件名中：

• 供应商A的XML文件名格式：(...)ZC299(...).xml（类型文本位于文件名中间）
• 供应商B的XML文件名格式：ZC299 (...).xml（类型文本后带空格）

我需要按XML类型将附件分别保存到对应三个文件夹，但现有VBA脚本仅对供应商B的附件生效，推测是脚本无法识别文件名中间的类型文本。

原VBA脚本 #

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

问题分析 #

原脚本中InStr函数本身可以识别文件名任意位置的目标文本，出现仅供应商B生效的情况，大概率不是文本位置的问题，可能是以下原因：

1. 供应商A的文件名中存在特殊字符，导致DisplayName获取不全
2. 目标文件夹路径未正确配置（比如路径末尾缺少反斜杠，或文件夹不存在）
3. 脚本逻辑未优先过滤非XML附件，可能干扰匹配

优化后的VBA脚本 #

以下脚本优化了逻辑，先确认是XML附件，再判断类型，同时增加文件夹存在性检查，避免保存失败：

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:\IE529_Files"
    KatalogIE599 = "C:\IE599_Files"
    KatalogZC299 = "C:\ZC299_Files"
    
    ' 确保目标文件夹存在，不存在则创建
    CreateFolderIfNotExists KatalogIE529
    CreateFolderIfNotExists KatalogIE599
    CreateFolderIfNotExists KatalogZC299
    
    For Each Zalacznik In MItem.Attachments
        ' 先判断是否为XML附件
        If LCase(Right(Zalacznik.DisplayName, 4)) = ".xml" Then
            ' 判断XML类型并保存
            If InStr(1, Zalacznik.DisplayName, "IE529", vbTextCompare) > 0 Then
                Zalacznik.SaveAsFile KatalogIE529 & "\" & Zalacznik.DisplayName
            ElseIf InStr(1, Zalacznik.DisplayName, "IE599", vbTextCompare) > 0 Then
                Zalacznik.SaveAsFile KatalogIE599 & "\" & Zalacznik.DisplayName
            ElseIf InStr(1, Zalacznik.DisplayName, "ZC299", vbTextCompare) > 0 Then
                Zalacznik.SaveAsFile KatalogZC299 & "\" & Zalacznik.DisplayName
            End If
        End If
    Next
End Sub

' 辅助函数：创建文件夹（如果不存在）
Private Sub CreateFolderIfNotExists(folderPath As String)
    If Dir(folderPath, vbDirectory) = "" Then
        MkDir folderPath
    End If
End Sub

关键优化点 #

• 先过滤XML附件，减少无效判断
• 增加文件夹自动创建逻辑，避免因文件夹不存在导致保存失败
• 明确InStr返回值判断（>0），逻辑更清晰
• 统一用LCase判断后缀，避免大小写问题

内容的提问来源于stack exchange，提问作者DamianD