T3795_Send Gmail Attach Workbook File By SaveCopyAs CDO

https://excel-egy.com/forum/t3795
---------------------------------

'https://www.google.com/settings/security/lesssecureapps
'Enable Less Secure Apps (ON)
'-------------------------------------------------------

Sub Send_Gmail_Attach_Workbook_File_By_SaveCopyAs_Using_CDO()
    Dim cdoMsg      As Object
    Dim strTo       As String
    Dim strSubj     As String
    Dim strMsg      As String
    Dim strCC       As String
    Dim strBCC      As String
    Dim strBody     As String
    Dim userEmail   As String
    Dim password    As String
    Dim file        As String
    Dim cdoNS       As String

    'Email Information
    strTo = "Type The Email That You Will Send The Message To"
    strSubj = "This Is The Subject Line"
    strMsg = ""
    strCC = ""
    strBCC = ""
    strBody = "Hello My Friend" & vbCrLf & "Here Are The Required Attachment"

    'Gmail Account Information
    userEmail = "Your GMAIL"
    password = "Your Password"

    file = Environ$("temp") & "\HR-1_" & Format(Date, "yyyymmdd") & ".xlsm"
    ThisWorkbook.SaveCopyAs file

    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
            .Item(cdoNS & "smtpauthenticate") = 1
            .Item(cdoNS & "sendusername") = userEmail
            .Item(cdoNS & "sendpassword") = password
            .Item(cdoNS & "smtpserver") = "smtp.gmail.com"
            .Item(cdoNS & "sendusing") = 2
            .Item(cdoNS & "smtpserverport") = 465
            .Item(cdoNS & "smtpconnectiontimeout") = 60
            .Update
        End With

        .Send
    End With

    MsgBox "Message Sent", 64
End Sub