vba - 为什么保存的附件的文件名包含预期保存文件夹的名称？

Question

我正在尝试:

1. 检查电子邮件中的附件

2. 如果电子邮件包含附件，则通过电子邮件中每个附件的方法进行循环。

3. 该方法将在附件显示名称中搜索名称中任意位置的字符串匹配项，并相应地为其分配一个 ID

4. 如果附件是 .pdf，它会根据 ID 将附件的副本保存到匹配的子文件夹中

我遇到的问题:

• InStr 似乎没有正确分配 ID

• 宏正在保存附件的副本，但它将它们重命名为文件夹名称，并且似乎没有根据 ID 进行排序。

• 保存副本后，我删除它们的唯一方法是通过 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

我对您的代码进行了相当多的更改以清理一些内容:

• 我删除了id，因为它似乎没有任何作用。为什么不直接跳过 分配id并直接分配保存路径？

• 我还将所有声明移至顶部，因为您不应该使用
  Dim 在循环内。

• 我删除了很多评论 - 评论应该保留给 对可能发生混淆的地方进行澄清 - 无需解释 您的所有 Dim 行都是声明，以及它们被声明的内容。如果有的话，如果您觉得有必要，只需以 'Declarations 开头即可。

此外，Select Case 很棒 - 但您不能使用 Select Case 来评估 True。在您的场景中，If/ElseIf 语句就足够了:

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