Trying to convert a saved workbook to PDF, save then email

[Alstoj79]

Hi all, really need some help with this. searching the internet for a while now and can only get close and not sure how to amend code.
So basically all I want to do is
1, convert an already saved excel workbook to PDF
2, use the filename of the workbook that's already saved and save it in a separate subfolder folder
3, use an email address in a cell (say cell J1) and get it ready to send as an attachment in outlook to that email address

so far I have found this code to convert and save the workbook but it saves in the same location to my original. how would I get it to save in a separate subfolder i.e C:/foldername/foldername/subfoldername

then to add some code to open outlook, add the pdf to an attachment and send it to an email address that is in cell J1 of the workbook.
note, don't want it to automatically send I would like to hit the send button.

here is the code I have for the convert. Please can someone help and add the rest of the code I need. - Im a total newbie at this.

Sub EmailPDF()
Dim FSO As Object
Dim s(1) As String
Dim sNewFilePath As String
Set FSO = CreateObject("Scripting.FileSystemObject")
s(0) = ThisWorkbook.FullName

If FSO.FileExists(s(0)) Then
'//Change Excel Extension to PDF extension in FilePath
s(1) = FSO.GetExtensionName(s(0))
If s(1) <> "" Then
s(1) = "." & s(1)
sNewFilePath = Replace(s(0), s(1), ".pdf")

'//Export to PDF with new File Path
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=sNewFilePath, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=True
End If
Else
'//Error: file path not found
MsgBox "Error: this workbook may be unsaved. Please save and try again."
End If

Set FSO = Nothing
End Sub


many thanks

 

[Alstoj79]

Re: Newbie to VBA and Macros - Trying to convert a saved workbook to PDF, save then email

Hello All again,

I have been trying by myself to work out how to amend the above code in post #26 to add my default outlook signature when the email is created. Its all really confusing me now as I just don't get it! all these dims ends, subs, what format things should be in. maybe I'll sign up to an online training course!
But, in the meantime, can someone advise me on how to get my default signature on the email I want to send.
I have amended the code in post #26 to suit me and is as follows:

First is the code in the FunctionsModule which i have not altered.

Option Explicit
'The code below are used by the macros in the other two modules
'Do not change the code in the functions in this module
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:=OpenPDFAfterPublish
        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 = 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

This is the code in my Module2 which I have amended to suit me and works great.

Option Explicit
'Note: The macro's in this module call the functions in the "FunctionsModule"
'Be sure that you also copy the code from this module if you want to use it in your own workbook.

Sub RDB_Worksheet_Or_Worksheets_To_PDF_And_Create_Mail()
    Dim FileName As String, signature As String
    
    
    FileName = RDB_Create_PDF(ActiveSheet, "E:\International Tooling\INVOICES\PDF INVOICES\" & ThisWorkbook.Name & ".pdf", True, False)
    
    If FileName <> "" Then
        RDB_Mail_PDF_Outlook FileName, Range("J2"), "Invoice for your order No: " & Range("C18"), _
                             "Thank you for your order. We have processed and despatched your order today." _
                           & vbNewLine & vbNewLine & "Please find your invoice attached", False
    Else
        MsgBox "Not possible to create the PDF, possible reasons:" & vbNewLine & _
               "Microsoft Add-in is not installed" & vbNewLine & _
               "You Canceled 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

If it helps the file location of the outlook signature I want to use is here:
C:\Users\Int. Tooling LTD\AppData\Roaming\Microsoft\Signatures\NewMail.htm and the file of the signature I want to use is NewMail.htm It contains a jpg logo along with some text. there is also a Rich Text Format File NewMail.rtf if that any help.

Thank all, you've been fantastic so far.

 

[Vivek Roshan]

Re: Newbie to VBA and Macros - Trying to convert a saved workbook to PDF, save then email

Hi Keithmct,

Thanks a lot for providing the code.

 

[Vivek Roshan]

Re: Newbie to VBA and Macros - Trying to convert a saved workbook to PDF, save then email

Hi Alstoj79,

Many thanks for the code you posted.

 

[Alstoj79]

Re: Newbie to VBA and Macros - Trying to convert a saved workbook to PDF, save then email

Hi All,

Still haven't managed to get the signature in outlook to come up, tried and failed many times!!

Any help would be grand.

Thanks

 

[Vivek Roshan]

Re: Newbie to VBA and Macros - Trying to convert a saved workbook to PDF, save then email

Hi Alstoj79,

Visit this website, may be you will find some help.

http://www.exceltrainingvideos.com

 

[Alstoj79]

Re: Newbie to VBA and Macros - Trying to convert a saved workbook to PDF, save then email

Yay,
Problem Solved - Now with working signature.
Looking at the original coding from RonDeBruin website and adapted.
Final Code as follows and all the code in red font is what I amended from my previous post above.

FunctionsModule

Option Explicit
'The code below are used by the macros in the other two modules
'Do not change the code in the functions in this module
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:=OpenPDFAfterPublish
        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,[COLOR=#FF0000] Signature As Boolean, [/COLOR]Se[COLOR=#FF0000][/COLOR][COLOR=#FF0000][/COLOR]nd 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
      [COLOR=#FF0000]  If Signature = True Then .Display[/COLOR]
        .To = StrTo
        .CC = ""
        .BCC = ""
        .Subject = StrSubject
       [COLOR=#FF0000] .HTMLBody = StrBody & "<br>" & .HTMLBody[/COLOR]
        .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

Module2 code:

Option Explicit
'Note: The macro's in this module call the functions in the "FunctionsModule"
'Be sure that you also copy the code from this module if you want to use it in your own workbook.

Sub RDB_Worksheet_Or_Worksheets_To_PDF_And_Create_Mail()
    Dim FileName As String
    
    FileName = RDB_Create_PDF(ActiveSheet, "C:\Users\Asus Laptop\Documents\Invoices\PDF Invoices\" & ThisWorkbook.Name & ".pdf", True, False)
    
    If FileName <> "" Then
        RDB_Mail_PDF_Outlook FileNamePDF:=[COLOR=#FF0000]FileName, _
                             StrTo:=Range("J2"), _
                             StrSubject:="Invoice for your order No: " & Range("C18"), _
                             Signature:=True, _[/COLOR]
                            [COLOR=#FF0000] Send:=False, _
                             StrBody:="<H3><B>Dear Customer</B></H3><br>" & _
                                      "******>Thank you for your order. We have processed and despatched your order today." & _
                                      "<br><br>" & "Please find your invoice attached</body>"[/COLOR]
    Else
        MsgBox "Not possible to create the PDF, possible reasons:" & vbNewLine & _
               "Microsoft Add-in is not installed" & vbNewLine & _
               "You Canceled 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

 

[Vivek Roshan]

Re: Newbie to VBA and Macros - Trying to convert a saved workbook to PDF, save then email

Hi Alstoj79,

Glad to hear that you have solved the longstanding problem. Keep it up.