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

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