Question

我正在尝试：

检查电子邮件中的附件
如果电子邮件通过电子邮件中的每个附件的方法包含一个附件循环。
该方法将在附件显示名称中搜索名称中任意位置匹配的字符串，并为其分配一个ID
如果附件是.pdf

问题，我正在遇到：

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

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

1 个答案: