Vba 为什么保存的附件'；的文件名是否包括预期保存文件夹的名称？

我正在尝试：

检查电子邮件中的附件

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

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

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

我遇到的问题：

• InStr似乎没有正确分配id

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

• 保存副本后，我唯一可以删除它们的方法是通过cmd

---

---

我对您的代码做了很多更改，以清理一些内容：

• 我删除了

  id

  ，因为它似乎毫无用处。为什么不跳过呢 分配

  id

  并向右分配保存路径

• 我还将所有声明移至顶部，因为您不应该使用
  

  Dim

  在循环内

• 我已经删除了很多评论-评论应该保留给 在可能出现混淆的地方进行澄清-无需解释 所有的

  Dim

  行都是声明，它们被声明为什么。如果有什么需要的话，只要用

  声明开始这个代码段就可以了
  

另外，

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

---

非常感谢您的快速响应和最佳实践！你知道为什么它仍然在更改附件的命名约定，并将所有内容发送到其他sSaveFolder=“C:\Users\jkassels\Desktop\test”是将它们保存为

test4MyDocument

还是什么吗？我没注意到你少了一些背部伤口。我添加了反斜杠，但除非您确实有名为

test

到

test5

的文件夹，否则这些文件夹可能是不必要的-我需要您的说明。您试图将这些文件保存到哪里？仅指向

test

文件夹，或此测试文件夹中的

test1、test2、test3、test4、test5

文件夹？我正在尝试将附件路由到

test

文件夹中的子文件夹。如果没有匹配项，则默认为根

test

文件夹

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