Page 28 of 28 FirstFirst ... 18262728
Results 271 to 277 of 277

Thread: VBA code to convert excel to pdf and email it as attachment

  1. #271
    MrExcel MVP ZVI's Avatar
    Join Date
    Apr 2008
    Location
    Sevastopol
    Posts
    3,644
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    3 Thread(s)

    Default Re: VBA code to convert excel to pdf and email it as attachment

    Quote Originally Posted by turkanet View Post
    Dear ZVI,
    how to change the code to send mail from specific mail account (not default one) and with its signature on outlook?
    thank you
    Hi, try using one of the solutions of Ron de Bruin shown in his web page Insert Outlook Signature in mail
    Vladimir Zakharov

  2. #272
    MrExcel MVP ZVI's Avatar
    Join Date
    Apr 2008
    Location
    Sevastopol
    Posts
    3,644
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    3 Thread(s)

    Default Re: VBA code to convert excel to pdf and email it as attachment

    Or use the below code where the setting Const Account is an index or a name of the required account with its default signature.
    Code:
    Sub SendPDF_WithAccountSignatiure()
     
      ' --> User settings, change to suit
      Const IsDisplay As Boolean = True  ' Change to False for .Send instead of .Display
      Const IsSilent As Boolean = False  ' Change to True to show Send status
      Const FontName = "Candara"         ' Font name of the email body
      Const FontSize = 11                ' Font size of the email body
      Const Account = 2                  ' Index or Name of the account to send from
      ' <-- End of the settings
     
      Dim IsCreated As Boolean
      Dim OutlApp As Object
      Dim char As Variant
      Dim PdfFile As String, HtmlFont As String, HtmlBody As String, HtmlSignature As String
     
      ' Edit the body's html text as required
      ' The tags are: h3 is for Header#3; b is for Bold; br is for line break
      ' HTML tag's are not displayed properly in the post of MrExcel forum, thus replacing is used to fix this problem
      HtmlBody = "First line, (br)" _
               & "Second line.(br)" _
               & "Third line."
      HtmlBody = Replace(HtmlBody, "(", "<")
      HtmlBody = Replace(HtmlBody, ")", ">")
     
      ' Set the font for the html-body (parentheses are just because of MrExcel posting limitation)
      HtmlFont = HtmlFont = "(body font: " & FontSize & "pt " & FontName & ";color:black"")"
      HtmlFont = Replace(HtmlFont, "(", "<")
      HtmlFont = Replace(HtmlFont, ")", ">")
     
      ' Define PDF filename
      PdfFile = Range("H2") & "_" & ActiveSheet.Name
     
      ' Replace illegal symbols in PdfFile by underscore
      For Each char In Split("? "" / \ < > * | :")
        PdfFile = Replace(PdfFile, char, "_")
      Next
     
      ' Apply %TEMP% path to the file name and limit lenght of the pathname
      PdfFile = Left(Environ("TEMP") & IIf(Right(Environ("TEMP"), 1) <> "\", "\", "") & PdfFile, 251) & ".pdf"
     
      ' Try to delete PDF file if present
      If Len(Dir(PdfFile)) Then Kill PdfFile
     
      ' Export the activesheet as PDF
      With ActiveSheet
        .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
      End With
     
      ' Use the already open Outlook if possible
      On Error Resume Next
      Set OutlApp = GetObject(, "Outlook.Application")
      If Err Then
        Set OutlApp = CreateObject("Outlook.Application")
        IsCreated = True
      End If
      OutlApp.Visible = True
      On Error GoTo 0
     
      ' Prepare email with PDF attachment and the default signature
      With OutlApp.CreateItem(0)
     
        ' Set HTML format
        .BodyFormat = 2
        
        ' Add the attachment first for correct attachment's name with non English symbols
        .Attachments.Add PdfFile
     
        ' Set the required account by const Account
        Set .SendUsingAccount = OutlApp.Session.Accounts.Item(Account)
       
        ' Get default email signature without blinking (instead of .Display method)
        With .GetInspector: End With
        HtmlSignature = .HtmlBody
      
        ' Prepare e-mail
        .Subject = Range("H2") & " / " & Range("K1")
        .To = Range("L1")   ' <-- Put email of the recipient here
        .HtmlBody = HtmlFont & HtmlBody & HtmlSignature
              
        ' Try to send or just display the e-mail
        On Error Resume Next
        If IsDisplay Then .Display Else .Send
     
        ' Show error of the .Send method
        If Not IsDisplay Then
          ' Return focus to Excel's window
          Application.Visible = True
          ' Show error/success message
          If Err Then
            MsgBox "E-mail was not sent for some reasons" & vbLf & "Please check it", vbExclamation
            .Display
          Else
            If Not IsSilent Then
              MsgBox "E-mail successfully sent", vbInformation
            End If
          End If
        End If
        On Error GoTo 0
     
      End With
     
      ' Delete the temporary PDF file
      If Len(Dir(PdfFile)) Then Kill PdfFile
     
      ' Try to quit Outlook if it was not previously open
      If IsCreated Then OutlApp.Quit
     
      ' Try to release the memory of object variable
      Set OutlApp = Nothing
     
    End Sub
    Regards
    Last edited by ZVI; Feb 19th, 2019 at 11:18 AM.
    Vladimir Zakharov

  3. #273
    Board Regular WERNER SLABBERT's Avatar
    Join Date
    Mar 2009
    Posts
    100
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA code to convert excel to pdf and email it as attachment

    I have been trying( to no avail) to apply these steps to my Macro... but hell it gets confusing... can i kinda aslo maybe ask some help... ? the PDF save section works great, its the sending the attchment from specific account with my signature bit that has me baffled completely...
    Code:
    Sub SaveIt()  
        On Error Resume Next 'In case it already exists
    MkDir GetSpecialfolder(CSIDL_DESKTOP) & "\Famous_Brands" & "\" & Range("C7").Value
        
        ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
    
    
        Dim Filename As String
        Dim Path As String
        Dim i As Integer
        Dim Mail_Object
        Dim Email_Subject
        Dim o As Variant
        
        Filename = Format(Date, "yyyy_mm_dd") & "_" & Range("J7").Value & "_" & Range("J8").Value
        Path = CreateObject("Wscript.Shell").SpecialFolders("Desktop")
        
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=Path & "\Famous_Brands" & "\" & Range("C7").Value & "\" & Filename & ".Pdf", _
                Quality:=xlQualityStandard, _
                IgnorePrintAreas:=False, _
                OpenAfterPublish:=True
    
    
        ActiveWorkbook.SaveAs Filename:=Path & "\Famous_Brands" & "\" & "Complete_Job_Card_2018", _
                                FileFormat:=xlOpenXMLTemplateMacroEnabled, _
                                Password:="", _
                                WriteResPassword:="", _
                                ReadOnlyRecommended:=False, _
                                CreateBackup:=False
                                                          
            ActiveWorkbook.SaveAs Filename:=Path & "\" & "Complete_Job_Card_2018", _
                                FileFormat:=xlOpenXMLTemplateMacroEnabled, _
                                Password:="", _
                                WriteResPassword:="", _
                                ReadOnlyRecommended:=False, _
                                CreateBackup:=False
                                            
                Set Mail_Object = CreateObject("Outlook.Application")
            With Mail_Object.CreateItem(o)
                .Subject = "Famous Brands Repair Job Card" ' CHANGE TO SUIT
                .To = "receptionpta@nexusgroup.co.za" 'CHANGE TO SUIT
                .Body = "Machine Repaired and Ready for collection or courier." & Chr(13) & Chr(13) & "Regards," & Chr(13) & "Werner Johan Slabbert" & Chr(13) & "Nexus Technical" 'Change comments to suit
                .Attachments.Add Filename
                .Send
        End With
            MsgBox "E-mail successfully sent", 64
            Application.DisplayAlerts = False
    Set Mail_Object = Nothing
    
    
     
    End Sub
    Quote Originally Posted by ZVI View Post
    Or use the below code where the setting Const Account is an index or a name of the required account with its default signature.
    Code:
    Sub SendPDF_WithAccountSignatiure()
     
      ' --> User settings, change to suit
      Const IsDisplay As Boolean = True  ' Change to False for .Send instead of .Display
      Const IsSilent As Boolean = False  ' Change to True to show Send status
      Const FontName = "Candara"         ' Font name of the email body
      Const FontSize = 11                ' Font size of the email body
      Const Account = 2                  ' Index or Name of the account to send from
      ' <-- End of the settings
     
      Dim IsCreated As Boolean
      Dim OutlApp As Object
      Dim char As Variant
      Dim PdfFile As String, HtmlFont As String, HtmlBody As String, HtmlSignature As String
     
      ' Edit the body's html text as required
      ' The tags are: h3 is for Header#3; b is for Bold; br is for line break
      ' HTML tag's are not displayed properly in the post of MrExcel forum, thus replacing is used to fix this problem
      HtmlBody = "First line, (br)" _
               & "Second line.(br)" _
               & "Third line."
      HtmlBody = Replace(HtmlBody, "(", "<")
      HtmlBody = Replace(HtmlBody, ")", ">")
     
      ' Set the font for the html-body (parentheses are just because of MrExcel posting limitation)
      HtmlFont = HtmlFont = "(body font: " & FontSize & "pt " & FontName & ";color:black"")"
      HtmlFont = Replace(HtmlFont, "(", "<")
      HtmlFont = Replace(HtmlFont, ")", ">")
     
      ' Define PDF filename
      PdfFile = Range("H2") & "_" & ActiveSheet.Name
     
      ' Replace illegal symbols in PdfFile by underscore
      For Each char In Split("? "" / \ < > * | :")
        PdfFile = Replace(PdfFile, char, "_")
      Next
     
      ' Apply %TEMP% path to the file name and limit lenght of the pathname
      PdfFile = Left(Environ("TEMP") & IIf(Right(Environ("TEMP"), 1) <> "\", "\", "") & PdfFile, 251) & ".pdf"
     
      ' Try to delete PDF file if present
      If Len(Dir(PdfFile)) Then Kill PdfFile
     
      ' Export the activesheet as PDF
      With ActiveSheet
        .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
      End With
     
      ' Use the already open Outlook if possible
      On Error Resume Next
      Set OutlApp = GetObject(, "Outlook.Application")
      If Err Then
        Set OutlApp = CreateObject("Outlook.Application")
        IsCreated = True
      End If
      OutlApp.Visible = True
      On Error GoTo 0
     
      ' Prepare email with PDF attachment and the default signature
      With OutlApp.CreateItem(0)
     
        ' Set HTML format
        .BodyFormat = 2
        
        ' Add the attachment first for correct attachment's name with non English symbols
        .Attachments.Add PdfFile
     
        ' Set the required account by const Account
        Set .SendUsingAccount = OutlApp.Session.Accounts.Item(Account)
       
        ' Get default email signature without blinking (instead of .Display method)
        With .GetInspector: End With
        HtmlSignature = .HtmlBody
      
        ' Prepare e-mail
        .Subject = Range("H2") & " / " & Range("K1")
        .To = Range("L1")   ' <-- Put email of the recipient here
        .HtmlBody = HtmlFont & HtmlBody & HtmlSignature
              
        ' Try to send or just display the e-mail
        On Error Resume Next
        If IsDisplay Then .Display Else .Send
     
        ' Show error of the .Send method
        If Not IsDisplay Then
          ' Return focus to Excel's window
          Application.Visible = True
          ' Show error/success message
          If Err Then
            MsgBox "E-mail was not sent for some reasons" & vbLf & "Please check it", vbExclamation
            .Display
          Else
            If Not IsSilent Then
              MsgBox "E-mail successfully sent", vbInformation
            End If
          End If
        End If
        On Error GoTo 0
     
      End With
     
      ' Delete the temporary PDF file
      If Len(Dir(PdfFile)) Then Kill PdfFile
     
      ' Try to quit Outlook if it was not previously open
      If IsCreated Then OutlApp.Quit
     
      ' Try to release the memory of object variable
      Set OutlApp = Nothing
     
    End Sub
    Regards
    Veni, Vidi, VELCRO..
    I CAME , I SAW.......
    I GOT STUCK ! ! !

  4. #274
    Board Regular WERNER SLABBERT's Avatar
    Join Date
    Mar 2009
    Posts
    100
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA code to convert excel to pdf and email it as attachment

    i also would like to implement this in my current macro but Veni,Vidi Velcro... it realy isn't as easy as my noob brain would make it out to be... here is my current macro (pieced together and all.. i would like to attach the saved file to the email with a specific account sending it and a specific signature called "Nexus"

    Please help all you smart people...

    Code:
    Sub SaveIt()  
        On Error Resume Next 'In case it already exists
    MkDir GetSpecialfolder(CSIDL_DESKTOP) & "\Famous_Brands" & "\" & Range("C7").Value
        
        ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
    
    
        Dim Filename As String
        Dim Path As String
        Dim i As Integer
        Dim Mail_Object
        Dim Email_Subject
        Dim o As Variant
        
        Filename = Format(Date, "yyyy_mm_dd") & "_" & Range("J7").Value & "_" & Range("J8").Value
        Path = CreateObject("Wscript.Shell").SpecialFolders("Desktop")
        
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=Path & "\Famous_Brands" & "\" & Range("C7").Value & "\" & Filename & ".Pdf", _
                Quality:=xlQualityStandard, _
                IgnorePrintAreas:=False, _
                OpenAfterPublish:=True
    
    
        ActiveWorkbook.SaveAs Filename:=Path & "\Famous_Brands" & "\" & "Complete_Job_Card_2018", _
                                FileFormat:=xlOpenXMLTemplateMacroEnabled, _
                                Password:="", _
                                WriteResPassword:="", _
                                ReadOnlyRecommended:=False, _
                                CreateBackup:=False
                                                          
            ActiveWorkbook.SaveAs Filename:=Path & "\" & "Complete_Job_Card_2018", _
                                FileFormat:=xlOpenXMLTemplateMacroEnabled, _
                                Password:="", _
                                WriteResPassword:="", _
                                ReadOnlyRecommended:=False, _
                                CreateBackup:=False
                                            
                Set Mail_Object = CreateObject("Outlook.Application")
            With Mail_Object.CreateItem(o)
                .Subject = "Famous Brands Repair Job Card" ' CHANGE TO SUIT
                .To = "receptionpta@nexusgroup.co.za" 'CHANGE TO SUIT
                .Body = "Machine Repaired and Ready for collection or courier." & Chr(13) & Chr(13) & "Regards," & Chr(13) & "Werner Johan Slabbert" & Chr(13) & "Nexus Technical" 'Change comments to suit
                .Attachments.Add Filename
                .Send
        End With
            MsgBox "E-mail successfully sent", 64
            Application.DisplayAlerts = False
    Set Mail_Object = Nothing
    
    
     
    End Sub
    Veni, Vidi, VELCRO..
    I CAME , I SAW.......
    I GOT STUCK ! ! !

  5. #275
    New Member
    Join Date
    Jul 2015
    Posts
    3
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA code to convert excel to pdf and email it as attachment

    Hi there I've pasted your recommended code as below however when I try to run it I get
    " Compile error:
    User-defined type not defined "
    at the same time "mypdfDist As New PdfDistiller" is highlighted.
    Any help please ?


    Code:
    Private Sub CommandButton1_Click()
    Dim tempPDFFileName, tempPSFileName, tempPDFRawFileName As String, mypdfDist As New PdfDistiller, _
     i As Integer, Mail_Object, Email_Subject, o As Variant
        tempPDFRawFileName = "V:\Manufacturing\Forms\Handover\Auto Handover Archive\DO NOT DELETE" & Range("CL2") ' Change File Path to suit
        tempPSFileName = tempPDFRawFileName & ".ps"
        tempPDFFileName = tempPDFRawFileName & ".pdf"
        ActiveSheet.PrintOut Copies:=1, preview:=False, ActivePrinter:="Adobe PDF", _
            printtofile:=True, Collate:=True, prtofilename:=tempPSFileName
        mypdfDist.FileToPDF tempPSFileName, tempPDFFileName, ""
         Kill tempPSFileName
    Set mypdfDist = Nothing
    
    
    '************End of PDF section*************
    '************Start of emailing code*********
        Set Mail_Object = CreateObject("Outlook.Application")
            With Mail_Object.CreateItem(o)
                .Subject = Range("CL2") ' CHANGE TO SUIT
                .To = "mark.horspool@radius-systems.com" 'CHANGE TO SUIT
                .Body = "E MAIL TEXT GOES HERE" & Chr(13) & Chr(13) & "Regards," & Chr(13) & "YOUR NAME." & Chr(13) & "YOUR ADDRESS." 'Change comments to suit
                .Attachments.Add tempPDFFileName
                .Send
        End With
            MsgBox "E-mail successfully sent", 64
            Application.DisplayAlerts = False
    Set Mail_Object = Nothing
    
    
    End Sub
    Last edited by RoryA; Jul 2nd, 2019 at 11:03 AM.

  6. #276
    New Member (M)
    Join Date
    Jul 2019
    Location
    Ahmedabad, Gujarat, INDIA
    Posts
    1
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA code to convert excel to pdf and email it as attachment

    Where can one get the [PDFDistiller] object referred to in the code above? Kindly send the link by reply and oblige.

  7. #277
    New Member
    Join Date
    Feb 2018
    Posts
    13
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA code to convert excel to pdf and email it as attachment

    Quote Originally Posted by WERNER SLABBERT View Post
    i also would like to implement this in my current macro but Veni,Vidi Velcro... it realy isn't as easy as my noob brain would make it out to be... here is my current macro (pieced together and all.. i would like to attach the saved file to the email with a specific account sending it and a specific signature called "Nexus"

    Please help all you smart people...

    Code:
    Sub SaveIt()  
        On Error Resume Next 'In case it already exists
    MkDir GetSpecialfolder(CSIDL_DESKTOP) & "\Famous_Brands" & "\" & Range("C7").Value
        
        ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
    
    
        Dim Filename As String
        Dim Path As String
        Dim i As Integer
        Dim Mail_Object
        Dim Email_Subject
        Dim o As Variant
        
        Filename = Format(Date, "yyyy_mm_dd") & "_" & Range("J7").Value & "_" & Range("J8").Value
        Path = CreateObject("Wscript.Shell").SpecialFolders("Desktop")
        
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=Path & "\Famous_Brands" & "\" & Range("C7").Value & "\" & Filename & ".Pdf", _
                Quality:=xlQualityStandard, _
                IgnorePrintAreas:=False, _
                OpenAfterPublish:=True
    
    
        ActiveWorkbook.SaveAs Filename:=Path & "\Famous_Brands" & "\" & "Complete_Job_Card_2018", _
                                FileFormat:=xlOpenXMLTemplateMacroEnabled, _
                                Password:="", _
                                WriteResPassword:="", _
                                ReadOnlyRecommended:=False, _
                                CreateBackup:=False
                                                          
            ActiveWorkbook.SaveAs Filename:=Path & "\" & "Complete_Job_Card_2018", _
                                FileFormat:=xlOpenXMLTemplateMacroEnabled, _
                                Password:="", _
                                WriteResPassword:="", _
                                ReadOnlyRecommended:=False, _
                                CreateBackup:=False
                                            
                Set Mail_Object = CreateObject("Outlook.Application")
            With Mail_Object.CreateItem(o)
                .Subject = "Famous Brands Repair Job Card" ' CHANGE TO SUIT
                .To = "receptionpta@nexusgroup.co.za" 'CHANGE TO SUIT
                .Body = "Machine Repaired and Ready for collection or courier." & Chr(13) & Chr(13) & "Regards," & Chr(13) & "Werner Johan Slabbert" & Chr(13) & "Nexus Technical" 'Change comments to suit
                .Attachments.Add Filename
                .Send
        End With
            MsgBox "E-mail successfully sent", 64
            Application.DisplayAlerts = False
    Set Mail_Object = Nothing
    
    
     
    End Sub
    Need help on corrections in this coding. I am receiving the PDF file in 4 pieces. I need it to be sent in one form. IS there a way to adjust the code to take all 4 pages and condense it to 1 page?
    Last edited by ddhuggi; Oct 3rd, 2019 at 12:33 PM.

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •