VBA code to email a pdf to all recipients from a drop down list?

[lharr28]

I've been working on a delinquency notice template that pulls the data into a template for each individual on the report. I've written code to email the pdf for each particular individual but you must do it one at a time. I'm looking for a code that will automatically email every individual on the report that is in the drop down list. I'm assuming some kind of loop must be created. Please help!

 

[lharr28]

More details: I have a statement that changes fields based on changing the cell in the dropdown list on B6. I found VBA code that automatically saves and prints every dropdown option in cell B6. Here is that code. But I also would like to be able to automatically email from Outlook every dropdown option in cell B6 to the email in O6 which will change based on changing the cell in B6.

 

[John_w]

Try this macro as a starting point - you will want to edit the Outlook email subject and body text, etc.

As posted, the code creates and displays the email for you to review and manually send. Just change the .Display line to .Send to send it automatically.

Option Explicit

Public Sub Email_PDF_To_All_People()

    Dim DVcell As Range
    Dim DVsource As Range
    Dim DVvalue As Range
    Dim PDFsFolder As String, PDFfile As String
    
    PDFsFolder = ActiveWorkbook.Path & "\"
    If Right(PDFsFolder, 1) <> "\" Then PDFsFolder = PDFsFolder & "\"
    
    Application.ScreenUpdating = False
    
    With ActiveSheet
        Set DVcell = .Range("B6")
        Set DVsource = Evaluate(DVcell.Validation.Formula1)
        For Each DVvalue In DVsource
            DVcell.Value = DVvalue
            PDFfile = PDFsFolder & DVcell.Value & ".pdf"
            .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFfile, _
                Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
            Send_Outlook_Email .Range("O6").Value, "Report for " & DVvalue, PDFfile
        Next
    End With

    Application.ScreenUpdating = True
    
    MsgBox "Done"

End Sub


Public Sub Send_Outlook_Email(toEmail As String, emailSubject As String, attachPDFfile As String)

    Static OutApp As Object
    Dim OutEmail As Object
    
    Const olMail = 0
    
    If OutApp Is Nothing Then
        On Error Resume Next
        Set OutApp = GetObject(, "Outlook.Application")
        If Err Then
            Set OutApp = CreateObject("Outlook.Application")
        End If
        On Error GoTo 0
    End If
    
    Set OutEmail = OutApp.CreateItem(olMail)
    
    With OutEmail
        .To = toEmail
        .Subject = emailSubject
        .Body = "Body text here"
        .Attachments.Add attachPDFfile
        .Display  'or .Send
    End With
     
End Sub

 

[lharr28]

Thanks! I've tried this and I get an error. Below is the code I've already written. How would you incorporate what you have into it? I would also like to change where the email is being sent from, not my email, but a shared email.

Sub EmailAspdf()

Const LineBreak = "<br>"

Dim EApp As Object
Set EApp = CreateObject("Outlook.Application")

Dim EItem As Object
Set EItem = EApp.CreateItem(0)

path = ""

fy = Range("K7")
month = Range("I7")
cardholder = Range("A7")
reportname = Range("A4")
fname = cardholder & " " & "CorpCardDELINQ Notice" & " " & Format(Date, "mm.d.yy")

ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
IgnorePrintAreas:=False, _
Filename:=path & fname

With EItem
.To = Range("D10")
.Cc = Range("D26")
.Bcc = Range("H26")
.Subject = reportname & " " & "(" & " " & Format(Date, "mm-d-yy") & ")"

.HTMLbody = "Dear Cardholder,<br/><br/>This is notice that you currently have a <b>past due</b> amount on your <b>Corporate Card</b>. Please review the attached report for details and notify your departmental liaison of your plan of action to resolve this issue within <b><u>two business days</b></u>. <br/><br/> <font color = red><b><i>If these items have already been processed, please advise and disregard this notice.</font color></b></i><br/><br/>Warm regards,"


.Attachments.Add (path & fname & ".pdf")
.Display

End With


End Sub

 

[lharr28]

I went back and altered some items and I got it to work, I ran into two issues.

1. How do I change the name of the pdf file that is attached and the path of where it is saved? It's saving the file with the last name with some weird characters?

2. Is there a way to change the from mailbox? I need to send the files from a shared mailbox?

 

[John_w]

1. How do I change the name of the pdf file that is attached and the path of where it is saved? It's saving the file with the last name with some weird characters?

I don't see how the file name in your screenshot relates to the code you posted. As posted, the cardholder name is read from A7 (cardholder = Range("A7")), so what is the value of A7?

The folder where the PDF is saved is defined by the path variable, which is empty (path = "") in the code above, which means it's saved in the workbook's default folder. Define path with a specific folder: path = "C:\path\to\folder\".

2. Is there a way to change the from mailbox? I need to send the files from a shared mailbox?

Search the forum for 'Outlook shared mailbox' and there should be example code.

 

[lharr28]

I don't see how the file name in your screenshot relates to the code you posted. As posted, the cardholder name is read from A7 (cardholder = Range("A7")), so what is the value of A7?

The folder where the PDF is saved is defined by the path variable, which is empty (path = "") in the code above, which means it's saved in the workbook's default folder. Define path with a specific folder: path = "C:\path\to\folder\".



Search the forum for 'Outlook shared mailbox' and there should be example code.

Thank you, I removed the path information from the sample because it had personal info in it.