Skip to main content
Support is Online
We're back! We are here to assist you. Please be patient, we will respond to your tickets shortly.
Official support hours
Monday To Friday
From 09:00 To 17:30
  Wednesday, 09 June 2021
  0 Replies
  2.6K Visits
0
Votes
Undo
I have a macro working to save the selected tab as a pdf into a selected file path and email to list of people within a certain cell, but what I cannot get to work correctly is for the name of that saved and attached pdf to be a cell value in the worksheet. Would appreciate any help. I've tried various things I've found through these forums but it keeps giving me an error so I'll go back to my saved code. Below is where I am at:Sub Saveaspdfandsend2()Dim xSht As WorksheetDim xFileDlg As FileDialogDim xFolder As StringDim xYesorNo As IntegerDim xOutlookObj As ObjectDim xEmailObj As ObjectDim xUsedRng, xRgInser As RangeDim xB As BooleanSet xSht = ActiveSheetxPath = "C:\Users\XXX" xFolder = xPath + "\" + xSht.Name + ".pdf"  If Len(Dir(xFolder)) > 0 ThenxYesorNo = MsgBox(xFolder & " already exists." & vbCrLf & vbCrLf & "Do you want to overwrite it?", _vbYesNo + vbQuestion, "File Exists")On Error Resume NextIf xYesorNo = vbYes ThenKill xFolderElseMsgBox "if you don't overwrite the existing PDF, I can't continue." _& vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Exiting Macro"Exit SubEnd IfIf Err.Number <> 0 ThenMsgBox "Unable to delete existing file. Please make sure the file is not open or write protected." _& vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Unable to Delete File"Exit SubEnd IfEnd If  Set xUsedRng = xSht.UsedRangeIf Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Then'Save as PDF filexSht.ExportAsFixedFormat Type:=xlTypePDF, Filename:=xFolder, Quality:=xlQualityStandard 'Create Outlook emailSet xOutlookObj = CreateObject("Outlook.Application")Set xEmailObj = xOutlookObj.CreateItem(0)With xEmailObj.Display.To = Range("S7").CC = Range("S8").BCC = Range("S5").Subject = Range("S6") + "-" + xStr + ".pdf".Attachments.Add xFolderIf DisplayEmail = False Then'.SendEnd IfEnd WithElseMsgBox "The active worksheet cannot be blank"Exit SubEnd IfEnd Sub
There are no replies made for this post yet.