Hi All!
I have the following macro in a macro enabled template and I want it to create the pdf and display it ready for sending from outlook, but the 8th line down is the problem, starting "FileName = RDB_Create_PDF..." I think.
All in all;
Create PDF,
Display in Outlook with recipient/subject/body
Close application without saving.
really hope someone can help?? =[
Sub twomacroswork()
SendEmailPDFAdam
CloseWorkbook
End Sub
Sub SendEmailPDFAdam()
Dim FileName As String
'Call the function with the correct arguments
FileName = RDB_Create_PDF(ActiveWorkbook, "W:\Enquiry Forms\" & Format(Now(), "yymmdd hh.mm.ss") & " " & Range("L1") & ".pdf", True, True)
If FileName <> "" Then
RDB_Mail_PDF_Outlook FileName, "", "Customer Enquiry.", _
"Customer enquiry for you." & vbNewLine & _
"Please see the attached PDF for details." _
& vbNewLine & vbNewLine & "Regards", False
Else
MsgBox "Not possible to create the PDF, possible reasons:" & vbNewLine & _
"Microsoft Add-in is not installed" & vbNewLine & _
"You cancelled the GetSaveAsFilename dialog" & 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 Sub
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 If the Microsoft 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
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 we test if the PDF
'already exist in the folder and Exit the function if that is True
If OverwriteIfFileExist = False Then
If Dir(Fname) <> "" Then Exit Function
End If
'Now the file name is correct we Publish to PDF
On Error Resume Next
Myvar.ExportAsFixedFormat _
Type:=xlTypePDF, _
FileName:=Fname, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
On Error GoTo 0
'If Publish is Ok the function will 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 = "email address"
.CC = ""
.BCC = ""
.Subject = StrSubject
.Body = StrBody
.Attachments.Add FileNamePDF
.Importance = 2
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Function
Sub CloseWorkbook()
Application.Quit
ThisWorkbook.Close savechanges:=False
End Sub
Bookmarks