Been Looking around a way to avoid using HTMLbody as at work we have different signatures with different images and disclaimers. Everyone has their own signature set up using outlooks default tool. Is there anyway I can get the users own default signature added to this code in outlook without manually building a bunch of HTML signatures? Currently in outlook when we generate a new email the signature appears as default but using the below code removes it.
Thanks!
Thanks!
Code:
Sub Saveaspdfandsend()
Dim xSht As Worksheet
Dim xFile As String
Dim xYesorNo As Integer
Dim xOutlookObj As Object
Dim xEmailObj As Object
Dim xUsedRng As Range
Set xSht = ActiveSheet
fNme = xSht.Range("A44").Value
xFile = "S:\Folder1\Folder2" & "\" & fNme & ".pdf"
'Check if file already exist
If Len(Dir(xFile)) > 0 Then
xYesorNo = MsgBox(xFile & " already exists." & vbCrLf & vbCrLf & "Do you want to overwrite it?", _
vbYesNo + vbQuestion, "File Exists")
On Error Resume Next
If xYesorNo = vbYes Then
Kill xFile
Else
MsgBox "if you don't overwrite the existing PDF, I can't continue." _
& vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Exiting Macro"
Exit Sub
End If
If Err.Number <> 0 Then
MsgBox "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 Sub
End If
End If
Set xUsedRng = xSht.UsedRange
If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Then
'Save as PDF file
xSht.ExportAsFixedFormat Type:=xlTypePDF, Filename:=xFile, Quality:=xlQualityStandard
'Create Outlook email
Set xOutlookObj = CreateObject("Outlook.Application")
Set xEmailObj = xOutlookObj.CreateItem(0)
With xEmailObj
.Display
.to = Range("Sheet2!B7").Value
.CC = "Address@place.com"
.Subject = "Invoice " & Range("A44").Value
.Body = "Good " & Range("Sheet2!C3") & "," & vbNewLine & vbNewLine & "Please find enclosed invoice relating to Claim Number " & Range("B14").Value & " for your attention." & vbNewLine & vbNewLine & "Should you have any queries about this please contact me on the details below." & vbNewLine & vbNewLine
.Attachments.Add xFile
If DisplayEmail = False Then
'.Send
End If
End With
Else
MsgBox "The active worksheet cannot be blank"
Exit Sub
End If
End Sub