VBA to send PDF with outlook

[Shadkng]

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.

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

 

[GWteB]

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

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]

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]

As the comment states ... provide the path to the file you want attached :

.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]

@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]

@GWteB can you specify which email address sends the email?

The one that is set as the default in the account settings.

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]

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

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]

Here is an example ... change the cell as required :

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 :

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

 

[Shadkng]

Here is an example ... change the cell as required :

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 :

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

 

[Shadkng]

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