仅使用 If UCase + SaveAsFile + SenderEmailAddress 保存 PDF 附件

Question

我有两个 VBA 宏，它们略有不同，我想结合两者的优点。

两者都在选定的电子邮件中保存附件，但是：

宏 A 将所选内容中的每个附件保存为 PDF。有些是我不想要的 JPEG 签名或免责声明等。好的一面是 它使用 eml.SenderEmailAddress 这是超级的，因为我希望保存的附件的名称包括 'someone@something.com'

宏 B 将所选内容中的每个附件保存为 PDF，但使用 If UCase 函数仅过滤掉 PDF 文件。例如，如果电子邮件包含 .txt 和 .pdf 文件，则仅考虑 PDF 文件。 我不需要清理伪造的 pdf。
我不知道如何将 SenderEmailAddress 合并到这个宏中。

如何合并上面粗体中的特征？

宏 A)

Sub SaveAttachmentsFromSelectedItemsPDF()

    Dim currentItem As Object
    Dim currentAttachment As Attachment
    Dim saveToFolder As String
    Dim savedFileCountPDF As Long

    saveToFolder = "the_path_private_its_a_work_one_lol"

    savedFileCountPDF = 0
    For Each currentItem In Application.ActiveExplorer.Selection
        For Each currentAttachment In currentItem.Attachments
            If UCase(Right(currentAttachment.DisplayName, 4)) = ".PDF" Then
                currentAttachment.SaveAsFile saveToFolder & "\" & _
                    Left(currentAttachment.DisplayName, Len(currentAttachment.DisplayName) - 4) & "_" & Format(Now, "yyyy-mm-dd_hh-mm-ss") & ".pdf"
                savedFileCountPDF = savedFileCountPDF + 1
            End If
        Next currentAttachment
    Next currentItem

    MsgBox "Number of PDF files saved: " & savedFileCountPDF, vbInformation

End Sub

宏 B)

Sub attsave_yann()
Dim win As Outlook.Explorer
Dim sel As Outlook.Selection
Dim att As Outlook.Attachments
Dim eml As MailItem
Dim i As Integer
Dim fn As String
Dim objAtt As Outlook.Attachment

Dim myRandom As Double
Randomize 'Initialize the Rnd function
 
myRandom = Rnd 'Generate a random number between 0-1
 
 
' Count = Count + 1
 
Set win = Application.ActiveExplorer
Set sel = win.Selection
    For Each eml In sel
        Set att = eml.Attachments
        
        
        If UCase(Right(att.DisplayName, 4)) = ".PDF" Then
            For i = 1 To att.Count
                fn = "the_path_private_its_a_work_one_lol" & eml.SenderEmailAddress & "_" & Rnd & "_.pdf"
                att(i).SaveAsFile fn
            Next i
        End If
    Next
End Sub

Answer 1

B 快到了：

Sub attsave_yann()
    Dim eml As MailItem
    Dim fn As String
    Dim objAtt As Outlook.Attachment
    
    Randomize 'Initialize the Rnd function
    
    For Each eml In Application.ActiveExplorer.Selection
        For Each objAtt In eml.Attachments
            'need to test objAtt.DisplayName
            If UCase(objAtt.DisplayName) Like "*.PDF" Then
                fn = "the_path_private_its_a_work_one_lol" & _
                     DomainOnly(eml.SenderEmailAddress) & "_" & Rnd & "_.pdf"
                objAtt.SaveAsFile fn
            End If
        Next objAtt
    Next
End Sub

'return only the part after the `@`
Function DomainOnly(sAddr as string)
    Dim arr
    arr = Split(sAddr, "@")
    if UBound(arr) = 0 then
        DomainOnly = sAddr
    Else
        DomainOnly = arr(1)
    End If
End Function

仅使用 If UCase + SaveAsFile + SenderEmailAddress 保存 PDF 附件

Save PDF attachments only using If UCase + SaveAsFile + SenderEmailAddress

pdf

outlook

vba

email-attachments