I have two VBA macros that are slightly different and I want to combine the best of both.
Both save attachments within a selection of emails, however:
Macro A saves every attachment within the selection as a PDF. Some are JPEG signatures or disclaimers etc. that I don't want. The plus side is that it uses eml.SenderEmailAddress which is super as I want the name of the saved attachment to include 'someone@something.com'
Macro B saves every attachment within the selection as a PDF but uses the If UCase function to filter out PDF files only. For instance if an email contains a .txt and .pdf file, only the PDF file is considered. I don't have to clean out fake pdfs.
I cannot figure out how to incorporate SenderEmailAddress into this macro.
How do I merge the features in bold above?
Macro 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
Macro 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
B is almost there:
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