Consulting

Page 1 of 2 1 2 LastLast
Results 1 to 20 of 25

Thread: Add current worksheet as pdf to gmail

  1. #1
    VBAX Regular
    Joined
    Aug 2017
    Posts
    6
    Location

    Add current worksheet as pdf to gmail

    Hello,

    For my company i am busy to automate the invoice system. The main goal is:
    - to convert a brochure to a invoice (done)
    - The next thing is to make sure the invoicenumbers keep ascending (done)/ Save the invoice as pdf file(done)
    - Send the specific invoice to the customer through Gmail
    The last is the thing i cant get done.

    I already know how to send a new message by Gmail with a text by clicking a button in Excel but the problem is i am stuck at sending the specific invoice to the customer.

    Is there a way to choose a file to attach to the mail or is there a way to send the current worksheet(invoice) and at the same time save this invoice on the pc as pdf?

    i am pretty new with vba so i dont know what to do anymore

    Sub send_email_via_Gmail()
    
    Dim myMail As CDO.Message
    
    Set myMail = New CDO.Message
    
    ' i deleted the Http :// in the following rules because i could not post links because this is my first post
    
    myMail.Configuration.Fields.Item("schemas.microsoft. com/cdo/configuration/smtpusessl") = True
    
    myMail.Configuration.Fields.Item("schemas.microsoft. com/cdo/configuration/smtpauthenticate") = 1
    
    myMail.Configuration.Fields.Item("schemas.microsoft. com/cdo/configuration/smtpserver") = "smtp.gmail"
    
    myMail.Configuration.Fields.Item("schemas.microsoft. com/cdo/configuration/smtpserverport") = 25
    
    myMail.Configuration.Fields.Item("schemas.microsoft. com/cdo/configuration/sendusing") = 2
    
    myMail.Configuration.Fields.Item("schemas.microsoft. com/cdo/configuration/sendusername") = "company mail adres"
    
    myMail.Configuration.Fields.Item("schemas.microsoft. com/cdo/configuration/sendpassword") = "password"
    
    myMail.Configuration.Fields.Update
    
    With myMail
    .Subject = "Test Email from eisse"
    .From = """company name"" <company mail adres>"
    .To = "my mail adress"
    .CC = ""
    .BCC = ""
    .HTMLBody = the text to put in the mail
    .AddAttachment "C:/users/eisse/desktop/invoice 3.pdf"
    End With
    On Error Resume Next
    myMail.Send
    'MsgBox("Mail has been sent")
    Set myMail = Nothing
    
    End Sub

  2. #2
    VBAX Expert
    Joined
    May 2016
    Posts
    602
    Location
    This routine will allow the user to select afile:
    Sub testsel()
    Dim FSO
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Dim fDialog As FileDialog
    Path = ActiveWorkbook.Path & "\"
    
    
        Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
             
        'Optional: FileDialog properties
        fDialog.AllowMultiSelect = False
        fDialog.Title = "Select a file"
        fDialog.InitialFileName = Path
        'Show the dialog. -1 means success!
        If fDialog.Show = -1 Then
            fileselected = fDialog.SelectedItems(1)
            fname = FSO.GetFileName(fileselected) 'The file name
        End If
        MsgBox fname
        
    
    
    End Sub

  3. #3
    VBAX Mentor Leith Ross's Avatar
    Joined
    Oct 2012
    Location
    San Francisco, California
    Posts
    490
    Location
    Hello eisse,

    This macro will save the Activesheet as a PDF file to your Desktop. Edit the Email Information and Gmail Account Information sections to match your needs.

    Option Explicit
    
    
    ' Author:   Leith Ross
    ' Written:  August 06, 2017
    ' Summary:  This macro will save the  ActiveSheet to the User's Desktop and then send it in the email as an attachment.
    '
    ' Update:   August 07, 2017 - For CDO to work with Google's new security measures, you must first enable "Less Secure Apps".
    '           This can be done by accessing this page from your browser: https://myaccount.google.com/lesssecureapps?pli=1
    '
    '           If you do not then you will receive the following error message...
    ' *******************************************************************************'
    ' /             Run-time error '-2147220975 (800400211)':                        /
    ' /                                                                              /
    ' /             The message could not be sent to the SMTP server. The transport  /
    ' /             error code was 0x80040217. The server was not available.         /
    ' *******************************************************************************'
    
    
    Sub SendGmailPDF()
    
    
        Dim File        As String
        Dim Folder      As Variant
        Dim cdoNS       As String
        Dim cdoMsg      As Object
        Dim htmlMsg     As String
        Dim Password    As String
        Dim strBCC      As String
        Dim strCC       As String
        Dim strMsg      As String
        Dim strSubj     As String
        Dim strTo       As String
        Dim UserEmail   As String
        
            ' Email Information.
            strTo = ""
            strSubj = ""
            strMsg = ""
            strCC = ""
            strBCC = ""
            
            ' Gmail Account Information.
            UserEmail = "me@gmail.com"
            Password = "my_password"
            
            ' Save ActiveSheet as a PDF file to the user's Desktop and attach it to this email.
            With CreateObject("Shell.Application")
                Folder = .Namespace(0).Self.Path & "\"
                File = Folder & ActiveWorkbook.Name
                File = Left(File, InStrRev(File, ".")) & "pdf"
                ActiveSheet.Copy
                ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, FileName:=File
                ActiveWorkbook.Close SaveChanges:=False
            End With"
            
                cdoNS = "http://schemas.microsoft.com/cdo/configuration/"
        
                Set cdoMsg = CreateObject("CDO.Message")
    
    
                With cdoMsg
                    .To = strTo
                    .Subject = strSubj
                    .From = UserEmail
                    .CC = strCC
                    .BCC = strBCC
                    .TextBody = strBody
                    .AddAttachment File
                
                     With .Configuration.Fields
                        .Item(cdoNS & "smtpusessl") = True              ' Any non zero value is True
                        .Item(cdoNS & "smtpauthenticate") = 1           ' basic clear text
                        .Item(cdoNS & "sendusername") = UserEmail
                        .Item(cdoNS & "sendpassword") = Password
                        .Item(cdoNS & "smtpserver") = "smtp.gmail.com"
                        .Item(cdoNS & "sendusing") = 2                  ' Using Port
                        .Item(cdoNS & "smtpserverport") = 465           ' Gmail SMTP Port
                        .Item(cdoNS & "smtpconnectiontimeout") = 60
                        .Update
                    End With
                
                    .Send
                End With
            
    End Sub
    Sincerely,
    Leith Ross

  4. #4
    Thanks a lot Mr. Leith for this awesome code .. You are a legend

  5. #5
    VBAX Regular
    Joined
    Aug 2017
    Posts
    6
    Location
    Thank you very much Leith, it works perfectly, then a another simple question(a)

    Is there a possibility possibility to change te name of the attachment?

  6. #6
    Administrator
    VP-Knowledge Base
    VBAX Grand Master mdmackillop's Avatar
    Joined
    May 2004
    Location
    Scotland
    Posts
    14,489
    Location
    "File" is a variable. You can set it to whatever you want.
    1. Derived from the code as shown
    File = Folder & ActiveWorkbook.Name
    File = Left(File, InStrRev(File, ".")) & "pdf"
    2. Hard coded to a specific name e.g. File = "C:\Test\Test.pdf"
    3. Allows you to pick e.g. File = Application.GetOpenFilename()

    What are you after?
    MVP (Excel 2008-2010)

    Post a workbook with sample data and layout if you want a quicker solution.


    To help indent your macros try Smart Indent

    Please remember to mark threads 'Solved'

  7. #7
    VBAX Regular
    Joined
    Aug 2017
    Posts
    6
    Location
    Well, i want to change the name of the file to invoice + the name of the customer(so cell value related) + an invoicenumber (also cell related) instead of the name of the excel file

  8. #8
    Administrator
    VP-Knowledge Base VBAX Grand Master mdmackillop's Avatar
    Joined
    May 2004
    Location
    Scotland
    Posts
    14,489
    Location
    Something like
    file = ActiveWorkbook.Path & "\" & "Invoice_" & Sheets("Sheet1").[A1] & "_" & Sheets("Sheet1").[A2] & ".pdf"
    MVP (Excel 2008-2010)

    Post a workbook with sample data and layout if you want a quicker solution.


    To help indent your macros try Smart Indent

    Please remember to mark threads 'Solved'

  9. #9
    VBAX Regular
    Joined
    Aug 2017
    Posts
    6
    Location
    that does not seem to work unfortunately

  10. #10
    Administrator
    VP-Knowledge Base VBAX Grand Master mdmackillop's Avatar
    Joined
    May 2004
    Location
    Scotland
    Posts
    14,489
    Location
    Add Debug.print File and check the output in the Immediate window or post your workbook
    MVP (Excel 2008-2010)

    Post a workbook with sample data and layout if you want a quicker solution.


    To help indent your macros try Smart Indent

    Please remember to mark threads 'Solved'

  11. #11
    VBAX Regular
    Joined
    Aug 2017
    Posts
    6
    Location
    I used the exact code that Leith Ross posted and of course filled in my data for mail, password, subject etc.

    And the name i want to use for my attachment ="Verduurzaming woning + name(sheet "invoice" cell A2) + invoicenumber (sheet "invoice" cell C11)

  12. #12
    Administrator
    VP-Knowledge Base VBAX Grand Master mdmackillop's Avatar
    Joined
    May 2004
    Location
    Scotland
    Posts
    14,489
    Location
    Change
     ' Save ActiveSheet as a PDF file to the user's Desktop and attach it to this email.    With CreateObject("Shell.Application") 
            Folder = .Namespace(0).Self.Path & "\" 
            File = Folder & ActiveWorkbook.Name 
            File = Left(File, InStrRev(File, ".")) & "pdf" 
            ActiveSheet.Copy 
            ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, FileName:=File 
            ActiveWorkbook.Close SaveChanges:=False 
        End With
    to
     ' Save ActiveSheet as a PDF file to the user's Desktop and attach it to this email.  
     file = ActiveWorkbook.Path & "\" & "Verduurzaming woning" & "_" & Sheets("invoice").[A2] & "_" & Sheets("invoice").[C11] & ".pdf"
            Debug.Print file
            ActiveSheet.Copy
            ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=file
            ActiveWorkbook.Close SaveChanges:=False
    This creates, for me, a file called "F:\Verduurzaming woning_MDMacKillop_1234.pdf"
    Ensure that you have no illegal characters in your invoice number. e.g. "12/1234"
    MVP (Excel 2008-2010)

    Post a workbook with sample data and layout if you want a quicker solution.


    To help indent your macros try Smart Indent

    Please remember to mark threads 'Solved'

  13. #13
    VBAX Regular
    Joined
    Aug 2017
    Posts
    6
    Location
    Thank you very much, it works! If i may ask i have one last Question.
    How can i set the receiver of the mail based on a specific cell?

  14. #14
    Administrator
    VP-Knowledge Base VBAX Grand Master mdmackillop's Avatar
    Joined
    May 2004
    Location
    Scotland
    Posts
    14,489
    Location
    In specified cell
    John Smith <JS@gmail.com>

    If you want a greeting
    strbody = "Hi " & Split(Sheets("Invoice").[C12])(0) & vbCr & vbCr & strbody
    
    With cdoMsg 
            .To = Sheets("Invoice").[C12]
    MVP (Excel 2008-2010)

    Post a workbook with sample data and layout if you want a quicker solution.


    To help indent your macros try Smart Indent

    Please remember to mark threads 'Solved'

  15. #15
    Administrator
    VP-Knowledge Base VBAX Grand Master mdmackillop's Avatar
    Joined
    May 2004
    Location
    Scotland
    Posts
    14,489
    Location
    MVP (Excel 2008-2010)

    Post a workbook with sample data and layout if you want a quicker solution.


    To help indent your macros try Smart Indent

    Please remember to mark threads 'Solved'

  16. #16
    VBAX Regular
    Joined
    Aug 2019
    Location
    Fortaleza
    Posts
    8
    Location
    Awesome stuff here!
    Two needs I can't get my head around:
    01 - How to have it export only until the row where there is visible data;
    02 - How to export it without cells' borders, since visually, there's visually no border.

    Appreciate you sharing this!

    Cheers,

  17. #17
    VBAX Mentor Leith Ross's Avatar
    Joined
    Oct 2012
    Location
    San Francisco, California
    Posts
    490
    Location
    Hello santosonit,

    In question 01 did you mean until there is NO visible data?

    Can you post attachments showing before and after examples of the cell borders?
    Sincerely,
    Leith Ross

  18. #18
    VBAX Regular
    Joined
    Aug 2019
    Location
    Fortaleza
    Posts
    8
    Location
    Quote Originally Posted by Leith Ross View Post
    Hello santosonit,

    In question 01 did you mean until there is NO visible data?

    Can you post attachments showing before and after examples of the cell borders?

    Hello Leith,
    I actually ended up using the code below to limit the report to where there is visible data:
    If ActiveSheet.Range("A17").Value = "" Then
        lastrow = 16
        Application.EnableEvents = False
        Else
        lastrow = Range("A17").End(xlDown).Row
        End If
        Application.EnableEvents = True
        ActiveSheet.Range("A1:K" & lastrow).Select
        Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:=File, Quality:=xlQualityStandard, IgnorePrintAreas:=False
    As to the second question, I've found out that this is a confirguration change required at Excel's end.

    Thank you for the help!
    Last edited by santosonit; 09-11-2019 at 11:02 AM.

  19. #19
    VBAX Regular
    Joined
    Aug 2019
    Location
    Fortaleza
    Posts
    8
    Location

    Composing name with cells' content...

    Quote Originally Posted by mdmackillop View Post
    Change
     ' Save ActiveSheet as a PDF file to the user's Desktop and attach it to this email.    With CreateObject("Shell.Application") 
            Folder = .Namespace(0).Self.Path & "\" 
            File = Folder & ActiveWorkbook.Name 
            File = Left(File, InStrRev(File, ".")) & "pdf" 
            ActiveSheet.Copy 
            ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, FileName:=File 
            ActiveWorkbook.Close SaveChanges:=False 
        End With
    to
     ' Save ActiveSheet as a PDF file to the user's Desktop and attach it to this email.  
     file = ActiveWorkbook.Path & "\" & "Verduurzaming woning" & "_" & Sheets("invoice").[A2] & "_" & Sheets("invoice").[C11] & ".pdf"
            Debug.Print file
            ActiveSheet.Copy
            ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=file
            ActiveWorkbook.Close SaveChanges:=False
    This creates, for me, a file called "F:\Verduurzaming woning_MDMacKillop_1234.pdf"
    Ensure that you have no illegal characters in your invoice number. e.g. "12/1234"
    Hello Leith,
    After I've implemented your code + a couple of additions, I keep getting a pop up window with error 400:

    If UserEmail = "" Or Password = "" Then
                MsgBox "Informe seu email e senha!"
                Exit Sub
                Else
            With CreateObject("Shell.Application")
                'Folder = .Namespace(0).Self.Path & "\"
                File = ActiveWorkbook.Path & "\" & "Relatório de Comissao" & Sheets("Relatório de Comissão").[B5] & "_" & Sheets("Relatório de Comissão").[B8] & ".pdf"
                'File = Left(File, InStrRev(File, ".")) & "pdf"
                If ActiveSheet.Range("A17").Value = "" Then
                    lastrow = 16
                MsgBox "Não há comissão no período!"
                Exit Sub
                Application.EnableEvents = False
                Else
                    lastrow = Range("A17").End(xlDown).Row
                End If
                Application.EnableEvents = True
                ActiveSheet.Range("A1:K" & lastrow).Select
                Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:=File, Quality:=xlQualityStandard, IgnorePrintAreas:=False
                'ActiveWorkbook.Close SaveChanges:=False
               RelatorioComissao.Range("B5").Select
            
            End With
    What I am trying to achieve is to the file name saved with a name composed by some of the cells' contents, but I'm not sure my if statement(s) are causing Shell.Application to break.
    Although you've done much already, could you please help on this one, too?

    Cheers,
    Antonio

  20. #20
    VBAX Mentor Leith Ross's Avatar
    Joined
    Oct 2012
    Location
    San Francisco, California
    Posts
    490
    Location
    Hello Antonio,

    Error code 400 in VBA is a "catch-all" error code. It is not informative about the cause and be very hard to pinpoint why it is happening.

    The way the code is written now, the Application.Shell is redundant. I have re-written your code to make is easier to read and consolidated some of the code.

    Sub ExampleA()
    
    
            If UserEmail = "" Or Password = "" Then
                MsgBox "Informe seu email e senha!"
                GoTo Finished
            End If
        
                File = ActiveWorkbook.Path & "\" & "Relatório de Comissao" & Sheets("Relatório de Comissão").[B5] & "_" & Sheets("Relatório de Comissão").[B8] & ".pdf"
                If ActiveSheet.Range("A17").Value = "" Then
                    lastrow = 16
                    MsgBox "Não há comissão no período!"
                    GoTo Finsished
                Else
                    lastrow = Range("A17").End(xlDown).Row
                End If
                
                ActiveSheet.Range("A1:K" & lastrow).ExportAsFixedFormat Type:=xlTypePDF, Filename:=File, Quality:=xlQualityStandard, IgnorePrintAreas:=False
                
                RelatorioComissao.Range("B5").Select
       
    Finished:
                Application.EnableEvents = True
                
    End Sub
    This is presented to show you where the code would be placed in reference to the End Sub statement. You did not show the full If statement, so I can not be sure this wholly correct. Let me know what happens.

    Guma math a théid leat!
    (Good luck to you!)
    Sincerely,
    Leith Ross

Posting Permissions

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