Hello,
I am on the last stages of setting my auto emails from excel. I have everything working using Ron de bruins site and from some helpful members here. I have been trying to change the code to allow me to add extra lines to the body of the email. I have done it before but struggling where to put it in the below code. So far the template just has "hello" and then "Regards Ron de bruin" underneath.
I would like to add 2 more sentences with a space between each underneath. Can anyone help please? My code is below:
I am on the last stages of setting my auto emails from excel. I have everything working using Ron de bruins site and from some helpful members here. I have been trying to change the code to allow me to add extra lines to the body of the email. I have done it before but struggling where to put it in the below code. So far the template just has "hello" and then "Regards Ron de bruin" underneath.
I would like to add 2 more sentences with a space between each underneath. Can anyone help please? My code is below:
VBA Code:
Function RDB_Create_PDF(Myvar As Object, FixedFilePathName As String, _
OverwriteIfFileExist As Boolean, OpenPDFAfterPublish As Boolean) As String
Dim FileFormatstr As String
Dim Fname As Variant
'Test to see if the Microsoft Create/Send add-in is installed.
If Dir(Environ("commonprogramfiles") & "\Microsoft Shared\OFFICE" _
& Format(Val(Application.Version), "00") & "\EXP_PDF.DLL") <> "" Then
If FixedFilePathName = "" Then
'Open the GetSaveAsFilename dialog to enter a file name for the PDF file.
FileFormatstr = "PDF Files (*.pdf), *.pdf"
Fname = Application.GetSaveAsFilename("", filefilter:=FileFormatstr, _
Title:="Create PDF")
'If you cancel this dialog, exit the function.
If Fname = False Then Exit Function
Else
Fname = FixedFilePathName
End If
'If OverwriteIfFileExist = False then test to see if the PDF
'already exists in the folder and exit the function if it does.
If OverwriteIfFileExist = False Then
If Dir(Fname) <> "" Then Exit Function
End If
'Now export the PDF file.
On Error Resume Next
Myvar.ExportAsFixedFormat _
Type:=xlTypePDF, _
FileName:=Fname, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=OpenPDFAfterPublish
On Error GoTo 0
'If the export is successful, return the file name.
If Dir(Fname) <> "" Then RDB_Create_PDF = Fname
End If
End Function
Function RDB_Mail_PDF_Outlook(FileNamePDF As String, StrTo As String, _
StrSubject As String, StrBody As String, Send As Boolean)
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = StrTo
.CC = ""
.BCC = ""
.Subject = StrSubject
.Body = StrBody
.Attachments.Add FileNamePDF
If Send = True Then
.Send
Else
.Display
End If
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Function
Sub Mail_Every_Worksheet_With_Address_In_A1_PDF()
'This example works in Excel 2007 and Excel 2010.
Dim sh As Worksheet
Dim TempFilePath As String
Dim TempFileName As String
Dim FileName As String
'Set a temporary path to save the PDF files.
'You can also use another folder similar to
'TempFilePath = "C:\Users\Ron\MyFolder\"
TempFilePath = Environ$("temp") & "\"
'Loop through each worksheet.
For Each sh In ThisWorkbook.Worksheets
FileName = ""
'Test A1 for an e-mail address.
If sh.Range("A1").Value Like "?*@?*.?*" Then
'If there is an e-mail address in A1, create the file name and the PDF.
TempFileName = TempFilePath & "Sheet " & sh.Name & " of " _
& ThisWorkbook.Name & " " _
& Format(Now, "dd-mmm-yy h-mm-ss") & ".pdf"
FileName = RDB_Create_PDF(sh, TempFileName, True, False)
'If publishing is set, create the mail.
If FileName <> "" Then
RDB_Mail_PDF_Outlook FileName, sh.Range("A1").Value, "Late Loads", _
"Hello" _
& vbNewLine & vbNewLine & _
vbNewLine & vbNewLine & "Regards Ron de bruin", True
'After the e-mail is created, delete the PDF file in TempFilePath.
If Dir(TempFileName) <> "" Then Kill TempFileName
Else
MsgBox "Not possible to create the PDF, possible reasons:" & vbNewLine & _
"Microsoft Add-in is not installed" & vbNewLine & _
"The path to save the file in arg 2 is not correct" & vbNewLine & _
"You didn't want to overwrite the existing PDF if it exist"
End If
End If
Next sh
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
MsgBox "You have successfully emailed the Late Loads!"
End Sub
