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