Voyager7055
New Member
- Joined
- Apr 28, 2021
- Messages
- 3
- Office Version
- 365
- Platform
- Windows
Hi guys,
I have the below code but i want to now save as excel format but email as pdf, what changes do i need to make please.
Private Sub CommandButton1_Click()
On Error GoTo err_handler
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
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
ActiveWorkbook.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("D7").Value
.CC = Sheets("Asset Condition Inspection").Range("D6").Value & "; " & Range("D5").Value & "; " & Range("B9").Value & "; " & Range("C9").Value
.Subject = "Asset Condition Inspection: " & pdfFileName
.HTMLBody = strbody & " This report and the inspection to which it refers to, is intended to identify repairs, decorations, maintenance and statutory compliance that you are responsible for under your obligations in your agreement for your pub and sets out suggested action that we believe you should undertake to meet these obligations. It is not nor is it intended to be an exhaustive survey of the condition of the property, a structural survey report, an interim schedule of dilapidations or check on the suitability of statutory certification. You should obtain independent advice from a suitably qualified professional advisor such as Chartered Building Surveyor to advise you about any issues of concern, the structural condition of your property, preventive maintenance, testing of service media and associated plant and equipment and statutory compliance." & .HTMLBody '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
I have the below code but i want to now save as excel format but email as pdf, what changes do i need to make please.
Private Sub CommandButton1_Click()
On Error GoTo err_handler
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
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
ActiveWorkbook.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("D7").Value
.CC = Sheets("Asset Condition Inspection").Range("D6").Value & "; " & Range("D5").Value & "; " & Range("B9").Value & "; " & Range("C9").Value
.Subject = "Asset Condition Inspection: " & pdfFileName
.HTMLBody = strbody & " This report and the inspection to which it refers to, is intended to identify repairs, decorations, maintenance and statutory compliance that you are responsible for under your obligations in your agreement for your pub and sets out suggested action that we believe you should undertake to meet these obligations. It is not nor is it intended to be an exhaustive survey of the condition of the property, a structural survey report, an interim schedule of dilapidations or check on the suitability of statutory certification. You should obtain independent advice from a suitably qualified professional advisor such as Chartered Building Surveyor to advise you about any issues of concern, the structural condition of your property, preventive maintenance, testing of service media and associated plant and equipment and statutory compliance." & .HTMLBody '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