VBA, PDF excel outlook help

[Voyager7055]

Can anyone help me adapt the code please I need to add active sheet only and not work book and would like signature on the email as well.



Sub SavePdfAndSendEmail()

On Error GoTo err_handler

Dim oApp As Outlook.Application
Dim oMail As Outlook.MailItem

Dim currentDate As String
Dim folderPath As String
Dim pdfFileName As String
Dim pdfFullName As String
Dim duplicateNumber As Long

'// Construct the file name
currentDate = Format(Date, "dd-mm-yyyy")
folderPath = "O:\PP Surveyors\Lease Inspections\2021\Completed Surveys 2021\"
pdfFileName = Sheets("Asset Condition Inspection").Range("B3") & Sheets("Asset Condition Inspection").Range("B2").Value & " - " & currentDate
duplicateNumber = 1

'// Check if the file already exists
If Dir(folderPath & pdfFileName & ".pdf") <> "" Then
'// The file exists so append duplicateNumber to the file name and check if that also exists, if it does increment duplicateNumber and test again. Rinse and repeat.
Do While Dir(folderPath & pdfFileName & "-" & Format(duplicateNumber, "000") & ".pdf") <> ""
duplicateNumber = duplicateNumber + 1
Loop
'// Construct the new file name
pdfFileName = pdfFileName & "-" & Format(duplicateNumber, "000")
End If

'// Construct the full name (path, file name and extension)
pdfFullName = folderPath & pdfFileName & ".pdf"

'// Export the workbook as PDF
ActiveWorksheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:=pdfFullName

'// Open Outlook and create a new email
Set oApp = New Outlook.Application
Set oMail = oApp.CreateItem(olMailItem)

With oMail
.To = Sheets("Asset Condition Inspection").Range("C7").Value
.CC = Sheets("Asset Condition Inspection").Range("C6") & ", " & Range("C5") & ", " & Range("B9") & ", " & Range("C9")
.Subject = "Asset Condition Inspection: " & pdfFileName
.Body = " ......." 'This is the text that will appear in the body of the email. Remove it if not needed.
.Attachments.Add Source:=pdfFullName, Type:=xlTypePDF
.Display 'This will display the email so you can review it before sending. If you want to send it automatically replace .Display with .Send
End With

clean_exit:
Set oMail = Nothing
Set oApp = Nothing
Exit Sub


err_handler:
'Something has gone wrong, spit out an error messsage
MsgBox "The following error has occured: " & vbNewLine & Err.Number & ": " & Err.Description, vbCritical, "Error!"
GoTo clean_exit

End Sub

 

[yky]

If you change "ActiveWorksheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:=pdfFullName" to

Activesheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:=pdfFullName

and run the code, what'd you get?