Question

这是我到目前为止所做的：

Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
saveFolder = "P:\ME\TEST\"
Dim dateFormat
dateFormat = Format(Now, "yyyy.mm.dd")
 For Each objAtt In itm.Attachments
    If InStr(1, objAtt.FileName, "HALJD", vbTextCompare) > 0 Then
    objAtt.SaveAsFile saveFolder & dateFormat & " ASDF ADFA.pdf"
    ElseIf InStr(1, objAtt.FileName, "Generic", vbTextCompare) > 0 Then
    objAtt.SaveAsFile saveFolder & dateFormat & " asdf asdf asdf.pdf"
    ElseIf InStr(1, objAtt.FileName, "asdfa asdfsa", vbTextCompare) > 0 Then
    objAtt.SaveAsFile saveFolder & dateFormat & " asdfds adsfa asdf a.pdf"
    ElseIf InStr(1, objAtt.FileName, "asdfs_asdfs", vbTextCompare) Then
    objAtt.SaveAsFile saveFolder & dateFormat & " asfd asfda sadfsad.pdf"
    Else
  End If
 Set objAtt = Nothing
Next
End Sub

我收到两封名为完全相同的文件的电子邮件，除了一个是excel，一个是pdf。我只需要PDF但不确定如何编码。只需要在最后一个elseif语句后输入一行吧？让我知道你想出了什么。

感谢您的帮助！

Answer 1

我还没有完全测试过这个，因为它是你的代码和我的代码的组合。

要看的主要部分是
Set objFSO = CreateObject("Scripting.FileSystemObject")和
sExt = objFSO.GetExtensionName(objAtt.FileName)

Sub saveAttachtoDisk(ByVal item As MailItem)

    Dim objAtt As Attachment
    Dim i As Integer
    Dim dateFormat As String
    Dim objFSO As Object
    Dim sExt As String

    dateFormat = Format(Date, "yyyy.mm.dd")

    'Only proceed if the email contains attachements.
    If item.Attachments.Count > 0 Then
        Set objFSO = CreateObject("Scripting.FileSystemObject")

        'Cycle through each attachment on the email.
        For i = 1 To item.Attachments.Count
            Set objAtt = item.Attachments(i)

            'Get the extension of the attached file name.
            sExt = objFSO.GetExtensionName(objAtt.FileName)

            If sExt = "pdf" Then
                If InStr(1, objAtt.FileName, "HALJD", vbTextCompare) > 0 Then
                    objAtt.SaveAsFile saveFolder & dateFormat & " ASDF ADFA.pdf"
                ElseIf InStr(1, objAtt.FileName, "Generic", vbTextCompare) > 0 Then
                    objAtt.SaveAsFile saveFolder & dateFormat & " asdf asdf asdf.pdf"
                ElseIf InStr(1, objAtt.FileName, "asdfa asdfsa", vbTextCompare) > 0 Then
                    objAtt.SaveAsFile saveFolder & dateFormat & " asdfds adsfa asdf a.pdf"
                ElseIf InStr(1, objAtt.FileName, "asdfs_asdfs", vbTextCompare) Then
                    objAtt.SaveAsFile saveFolder & dateFormat & " asfd asfda sadfsad.pdf"
                End If
            End If

            'Any remaining events are completed before the code continues.
            DoEvents
            Set objAtt = Nothing
        Next i
        Set objFSO = Nothing
    End If
End Sub

Answer 2

考虑使用RIGHT(..., 3)直接检查文件名中的扩展名。为了便于阅读和维护，请考虑使用LIKE重新编写宏并有条件地定义字符串变量，然后在SaveAs中构建文件路径。最后，尝试使用一行If语句：

Public Sub saveAttachtoDisk(itm As Outlook.MailItem)

  Dim objAtt As Outlook.Attachment
  Dim saveFolder As String: saveFolder = "P:\ME\TEST\"
  Dim dateFormat: dateFormat = Format(Now, "yyyy.mm.dd")
  Dim strFile As String

  For Each objAtt In itm.Attachments

     If Right(objAtt.FileName, 3) = "pdf" Then
         If objAtt.FileName Like "*HALJD*" Then strFile = " ASDF ADFA.pdf"
         If objAtt.FileName Like "*Generic*" Then strFile = " asdf asdf asdf.pdf"
         If objAtt.FileName Like "*asdfa asdfsa*" Then strFile = " asdfds adsfa asdf a.pdf"
         If objAtt.FileName Like "*asdfs_asdfs*" Then strFile = " asfd asfda sadfsad.pdf"

         objAtt.SaveAsFile saveFolder & dateFormat & strFile
     End If          

  Next objAtt

  Set objAtt = Nothing
End Sub

仅保存PDF附件VBA Outlook

2 个答案: