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