VBA to send PDF with outlook

Shadkng

Active Member
Joined
Oct 11, 2018
Messages
301
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
 

Logit

Well-known Member
Joined
Aug 31, 2016
Messages
4,324
if it's not possible to have the new created PDF attached

That is incorrect. The suggestions I posted in #9 will do what you want. I'm not certain you fully understand what is being given to you to complete your project or is there
something else occurring on your end keeping you from moving forward ?

The *.PDF tells Excel to attach all pdf files that are located in that folder. If only one pdf file is there (the single pdf file you want attached), then that will be the only file that
is attached as there are no other pdf files in the folder. This approach does exactly what you are seeking. If there is an issue saving a single pdf file in the specified folder, please
describe what the issue would be so we can work through it.

Regarding " .Display " .... yes, that should display the email before it is sent. Sometimes it is necessar to have OUTLOOK open and running in the background prior to running
your workbook. Try that and see if it solves that issue.
 

Excel Facts

When they said...
When they said you are going to "Excel at life", they meant you "will be doing Excel your whole life".

Shadkng

Active Member
Joined
Oct 11, 2018
Messages
301
That is incorrect. The suggestions I posted in #9 will do what you want. I'm not certain you fully understand what is being given to you to complete your project or is there
something else occurring on your end keeping you from moving forward ?

The *.PDF tells Excel to attach all pdf files that are located in that folder. If only one pdf file is there (the single pdf file you want attached), then that will be the only file that
is attached as there are no other pdf files in the folder. This approach does exactly what you are seeking. If there is an issue saving a single pdf file in the specified folder, please
describe what the issue would be so we can work through it.

Regarding " .Display " .... yes, that should display the email before it is sent. Sometimes it is necessar to have OUTLOOK open and running in the background prior to running
your workbook. Try that and see if it solves that issue.
I guess I'm not clear on this. There will be other PDF's in the folder, so that's why I asked if the "new" PDF created in my code can be attached. And how do I incorporate this code into my code - do I just call this macro?
 

Logit

Well-known Member
Joined
Aug 31, 2016
Messages
4,324
Ok .. good information. I understand you don't want to have a single PDF file in the folder. So ... here is a different approach.
The following will allow you to choose which PDF file you want attached. Then it will display it before sending.

VBA Code:
Option Explicit

Sub SelPDFnMail()
Dim oLook As Object
Dim oMail As Object
Dim FD As Object
Dim vrtSelectedItem As Variant

    Set oLook = CreateObject("Outlook.Application")
    Set oMail = oLook.createitem(0)
    Set FD = Application.FileDialog(3)
    
    With oMail
        .to = "Jane Smith"
        .cc = "John Smith"
        .body = "Please see attached."
        .Subject = "Info Attached"
          
                FD.AllowMultiSelect = True
                FD.Filters.Clear
                FD.Filters.Add "All Files", "*.*"
                FD.InitialFileName = filePath = ActiveWorkbook.path & "\PDFQUOTES\" 

                If FD.Show = True Then
       For Each vrtSelectedItem In FD.SelectedItems
       .Attachments.Add vrtSelectedItem
       Next
    End If
            
    .Display

    End With
    
    Set FD = Nothing
    Set oMail = Nothing
    Set oLook = Nothing
    
End Sub

Of course you will need to add in the remainder of your previous code that does not apply to emailing and file selection.
 

Shadkng

Active Member
Joined
Oct 11, 2018
Messages
301
Ok .. good information. I understand you don't want to have a single PDF file in the folder. So ... here is a different approach.
The following will allow you to choose which PDF file you want attached. Then it will display it before sending.

VBA Code:
Option Explicit

Sub SelPDFnMail()
Dim oLook As Object
Dim oMail As Object
Dim FD As Object
Dim vrtSelectedItem As Variant

    Set oLook = CreateObject("Outlook.Application")
    Set oMail = oLook.createitem(0)
    Set FD = Application.FileDialog(3)
   
    With oMail
        .to = "Jane Smith"
        .cc = "John Smith"
        .body = "Please see attached."
        .Subject = "Info Attached"
         
                FD.AllowMultiSelect = True
                FD.Filters.Clear
                FD.Filters.Add "All Files", "*.*"
                FD.InitialFileName = filePath = ActiveWorkbook.path & "\PDFQUOTES\"

                If FD.Show = True Then
       For Each vrtSelectedItem In FD.SelectedItems
       .Attachments.Add vrtSelectedItem
       Next
    End If
           
    .Display

    End With
   
    Set FD = Nothing
    Set oMail = Nothing
    Set oLook = Nothing
   
End Sub

Of course you will need to add in the remainder of your previous code that does not apply to emailing and file selection.
I'm getting an error message "compile error: Invalid inside procedure".
 

Logit

Well-known Member
Joined
Aug 31, 2016
Messages
4,324

ADVERTISEMENT

Which line of code is highlighted ?
 

Shadkng

Active Member
Joined
Oct 11, 2018
Messages
301
Which line of code is highlighted ?
Actually my mistake, I gave it another sub name not realizing you had one. So it is running, but the file path is going to my documents and not to the folder where the workbook is located.
 

Shadkng

Active Member
Joined
Oct 11, 2018
Messages
301

ADVERTISEMENT

Actually my mistake, I gave it another sub name not realizing you had one. So it is running, but the file path is going to my documents and not to the folder where the workbook is located.

Which line of code is highlighted ?
I think I fixed the file path by changing your line from
FD.InitialFileName = filePath = ActiveWorkbook.path & "\PDFQUOTES\"
to
FD.InitialFileName = ActiveWorkbook.path & "\APDFQUOTES\"

Now it defaults to the correct folder from where I can choose the file.

I had another idea if you think it could work. In my original code that saves the PDF, I can save the PDF filename to a cell in the worksheet. In that case, can the outlook code look to the cell for the filename and then search it in the folder as a match and then attach it?
 

Shadkng

Active Member
Joined
Oct 11, 2018
Messages
301
Actually my mistake, I gave it another sub name not realizing you had one. So it is running, but the file path is going to my documents and not to the folder where the workbook is located.
Hi Logit, is there a way to change to a different "from" email than the default one in outlook?
 

Logit

Well-known Member
Joined
Aug 31, 2016
Messages
4,324
VBA Code:
With oMail
        .to = "Jane Smith"
        .cc = "John Smith"
        .SentOnBehalfOfName = "sales@domain.com"   '<--- add this ... change email as desired
        .body = "Please see attached."
        .Subject = "Info Attached"
          
                FD.AllowMultiSelect = True
                FD.Filters.Clear
                FD.Filters.Add "All Files
 

Shadkng

Active Member
Joined
Oct 11, 2018
Messages
301
Hi Logit, is there a way to change to a different "from" email than the default one in outlook?

VBA Code:
With oMail
        .to = "Jane Smith"
        .cc = "John Smith"
        .SentOnBehalfOfName = "sales@domain.com"   '<--- add this ... change email as desired
        .body = "Please see attached."
        .Subject = "Info Attached"
         
                FD.AllowMultiSelect = True
                FD.Filters.Clear
                FD.Filters.Add "All Files
Hi, thanks works great.

In my previous reply I asked:

I had another idea if you think it could work. In my original code that saves the PDF, I can save the PDF filename to a cell in the worksheet. In that case, can the outlook code look to the cell for the filename and then search it in the folder as a match and then attach it?
 
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,152,405
Messages
5,769,881
Members
425,578
Latest member
Ckrysa

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