VBA to send PDF with outlook

Shadkng

Active Member
Joined
Oct 11, 2018
Messages
306
Hi, the following code was written for me by an excel programmer who has since past away. This code creates a PDF of one of my excel worksheets, names it, and saves it a sub folder in the folder where the workbook is created. I would like to have the PDF automatically sent by outlook. I have seen online different code that works with outlook, but I was hoping my code could continue to do what it does, and then after the PDF is created open outlook, attach the file, and then send to an email that sits in a certain cell. I am not expecting that anyone writes all this for me, but if I know it can be done then I could outsource the job. Thanks for your help.

VBA Code:
Sub SALES_CONFIRMATION_PDF()

    Dim response As String
    Dim PrintAreaString As String
    Dim fpath As String
    Dim fName As String
    Dim fileSaveName As String, filePath As String
    Dim reply As Variant
    Dim lc As Long, GT As Long
    Dim shArr
    Dim witsMsg As String

If ActiveSheet.Name <> "DETAIL FORM" Then 'added condition to ensure correct worksheet 8/4/2019
    MsgBox ("Wrong sheet for creating PDF")
    Exit Sub
End If

Call PDFfolder 'Added to prevent Run Time Error 1004 - object not found 8/4/2019
   
Dim LR As Long, hite As Double, wits As Double
Dim i As Long, ii As Long
LR = Cells.Find("*", , , , xlByRows, xlPrevious).Row
lc = Cells.Find("*", , , , xlByColumns, xlPrevious).Column
wits = 0
hite = 0

    For i = 1 To lc
        If Columns(i).Hidden = False Then wits = wits + Columns(i).width
    Next i
   
    For ii = 1 To LR
        If Rows(ii).Hidden = False Then hite = hite + Rows(ii).Height
    Next ii
   
With PageSetup
   
            shArr = Array("DETAIL FORM") '<---- Sheets that the macro should work on. Change to your requirements
            For i = LBound(shArr) To UBound(shArr)
            With Sheets(shArr(i))
             GT = .Cells(1, 2) + .Cells(2, 2).Value
            .PageSetup.PrintArea = Range("A4:A" & GT).Resize(, lc).Address
If wits > 875 Then
.PageSetup.Orientation = xlLandscape

Else
witsMsg = MsgBox("This PDF will fit in Portrait mode. Select YES to continue. Select NO to print in Landscape", vbYesNo, "Printing Options.")
If witsMsg = vbYes Then
.PageSetup.Orientation = xlPortrait
Else
.PageSetup.Orientation = xlLandscape
End If
End If
            .PageSetup.Zoom = False
            .PageSetup.FitToPagesWide = 1
            .PageSetup.FitToPagesTall = False
            .PageSetup.LeftMargin = 36
            .PageSetup.TopMargin = 36
            .PageSetup.RightMargin = 36
            .PageSetup.BottomMargin = 36
            .PageSetup.PrintGridlines = False
    End With
    Next i
    fileSaveName = "FRIEDLAND SALES CONF " & [B7] & " " & "ORD# " & [E5]
   
    filePath = ActiveWorkbook.path & "\PDFQUOTES\" & fileSaveName & ".pdf"
    Shell Environ("windir") & "\explorer.exe """ & ActiveWorkbook.path() & "\PDFQUOTES\", vbNormalFocus
   
    reply = vbNo
    While Dir(filePath) <> vbNullString And fileSaveName <> "" And reply = vbNo
        reply = MsgBox("THE PDF " & fileSaveName & " ALREADY EXISTS." & vbCrLf & vbCrLf & "DO YOU WANT TO REPLACE THE FILE?  CHOOSE NO TO RENAME.", vbYesNo, "Save as PDF")
        If reply = vbNo Then
            fileSaveName = InputBox("Please enter a new file name:", "Save as PDF", fileSaveName)
        End If
        filePath = ActiveWorkbook.path & "\PDFQUOTES\" & fileSaveName & ".pdf" '8/5/2019 ''original code, returned to on 8/6/2019 '8-6-19 steve changed folder name to "APDFQUOTES"
        Shell Environ("windir") & "\explorer.exe """ & ActiveWorkbook.path() & "\PDFQUOTES\", vbNormalFocus '8/5/2019 'original code, returned to on 8/6/2019 '8-6-19 steve changed folder name to "APDFQUOTES"
    Wend
      
    If fileSaveName <> "" Then
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=filePath, Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True '(change this to "False" to prevent the file from opening after saving)
    Else
        MsgBox "PDF not created"
    End If
    End With
    End Sub
 

Excel Facts

Why does 9 mean SUM in SUBTOTAL?
It is because Sum is the 9th alphabetically in Average, Count, CountA, Max, Min, Product, StDev.S, StDev.P, Sum, VAR.S, VAR.P.

GWteB

Well-known Member
Joined
Sep 10, 2010
Messages
2,769
Office Version
  1. 2013
Platform
  1. Windows
A blank "template" macro to send an email with Excel's VBA using Outlook looks like this ...

VBA Code:
Public Sub MailUsingOutlookExample()

    Dim OutApp As Object
    Dim OutMail As Object

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
    With OutMail
        .To = ""
        .CC = ""
        .BCC = ""
        .Subject = ""
        .Body = ""
        .Attachments.Add "C:\Users\Shdkng\SomeFile.PDF"      ' <<< change file name to suit 
        
        .Display           ' << for review purposes
        '.Send             ' << sends the email
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub
 

Shadkng

Active Member
Joined
Oct 11, 2018
Messages
306
Thanks for your reply, but I am not sure how the code you sent answers my request to modify my existing code to work with the outlook code. Possibly you can explain in more detail. Thanks
 

Logit

Well-known Member
Joined
Aug 31, 2016
Messages
4,393
As the comment states ... provide the path to the file you want attached :

VBA Code:
.Attachments.Add "C:\Users\Shdkng\SomeFile.PDF"      ' <<< change file name to suit

The entire macro code creates an email and sends it by Outlook.
 

stockman256

New Member
Joined
Jul 25, 2010
Messages
8

ADVERTISEMENT

@GWteB can you specify which email address sends the email? I have 4 different emails in outlook and would like to be able to pick which one sends a message.
 

GWteB

Well-known Member
Joined
Sep 10, 2010
Messages
2,769
Office Version
  1. 2013
Platform
  1. Windows
@GWteB can you specify which email address sends the email?
The one that is set as the default in the account settings.

ScreenShot274.jpg



So if you change the desired e-mail address beforehand, your macro will pick the right address automatically.
With a manually created e-mail, if desired you can easily change the sending address using the From dropdown.
 

Shadkng

Active Member
Joined
Oct 11, 2018
Messages
306

ADVERTISEMENT

A blank "template" macro to send an email with Excel's VBA using Outlook looks like this ...

VBA Code:
Public Sub MailUsingOutlookExample()

    Dim OutApp As Object
    Dim OutMail As Object

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
    With OutMail
        .To = ""
        .CC = ""
        .BCC = ""
        .Subject = ""
        .Body = ""
        .Attachments.Add "C:\Users\Shdkng\SomeFile.PDF"      ' <<< change file name to suit
       
        .Display           ' << for review purposes
        '.Send             ' << sends the email
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub
In the code above, I would like to do the following:

In the "to" field I would like to use an email that is in a certain cell on a worksheet.
For the attachment, I need to attach the newly created PDF resulting from the code I provided. I will be a different file each time it's run.
Thanks
 

Logit

Well-known Member
Joined
Aug 31, 2016
Messages
4,393
Here is an example ... change the cell as required :

VBA Code:
On Error Resume Next
    With OutMail
        .To = .Range("A1").Value
        .CC = .Range("G2").Value
        .BCC = ""
        .Subject = "This Is Your Subject"
        .Body = "Please Review The Attached Document"
        .Attachments.Add "C:\Users\Shdkng\SomeFile.PDF"      ' <<< change file name to suit
        
        .Display           ' << for review purposes
        '.Send             ' << sends the email
    End With

Regarding the attached file ... if you place ONLY ONE PDF file in the folder, you can use this :

Code:
 .Attachments.Add "C:\Users\Shdkng\*.PDF"
 

Shadkng

Active Member
Joined
Oct 11, 2018
Messages
306
Here is an example ... change the cell as required :

VBA Code:
On Error Resume Next
    With OutMail
        .To = .Range("A1").Value
        .CC = .Range("G2").Value
        .BCC = ""
        .Subject = "This Is Your Subject"
        .Body = "Please Review The Attached Document"
        .Attachments.Add "C:\Users\Shdkng\SomeFile.PDF"      ' <<< change file name to suit
      
        .Display           ' << for review purposes
        '.Send             ' << sends the email
    End With

Regarding the attached file ... if you place ONLY ONE PDF file in the folder, you can use this :

Code:
 .Attachments.Add "C:\Users\Shdkng\*.PDF"
 

Shadkng

Active Member
Joined
Oct 11, 2018
Messages
306
if it's not possible to have the new created PDF attached, the following would work for me. Run a macro to just open outlook, insert the email from a cell, as you showed me, and then I can just drag the file in to outlook. I would need outlook window to open which it's not doing in the last code. I thought "display" does that. Thanks
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,163,407
Messages
5,831,436
Members
430,070
Latest member
Renske

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top