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

 

[Logit]

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.

 

[Shadkng]

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]

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.

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]

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.

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]

Which line of code is highlighted ?

 

[Shadkng]

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]

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]

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]

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]

Hi Logit, is there a way to change to a different "from" email than the default one in outlook?

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?