Friday, December 1, 2017

VBA automation to send email via gmail - email automation






 ensure -

1. Enable IMAP in google Settings
1. Two Step Authentication should be DISABLED
2. Allow less secure apps: ON
https://support.google.com/mail/answer/7104828


Private Sub btnEmail_Click()

Dim myMail As CDO.Message
Set myMail = New CDO.Message
Dim Login_EmailAddress, Login_EmailPassword, SMTPServer As String
Dim ServerPort As Integer
Dim To_Email, CC_Email, BCC_Email, Email_Subject, Email_Body, Attachment_Path As String
Dim FileExtn As String

'*****************************************************************************************
FileExtn = ".PDF"
'********************FROM ACCOUNT DETAILS********************************************
SMTPServer = "smtp.gmail.com"
ServerPort = 465
Login_EmailAddress = Sheet1.Range("O2").Value
Login_EmailPassword = Sheet1.Range("O3").Value
'*********************TO ACCOUNT DETAILS******************************************
To_Email = Sheet1.Range("L2").Value
CC_Email = Sheet1.Range("L3").Value
BCC_Email = Sheet1.Range("L4").Value
Attachment_Path = Sheet1.Range("L5").Value
Email_Subject = Sheet1.Range("L6").Value
Email_Body = Sheet1.Range("L7").Value
'**********************************************************************************


'if there is a file in the Attachment location and there is PDF written / you may change it to xls
If Sheet1.Range("L5").Value <> "" Then
    Sheet1.Calculate 'to refresh sheet
    Attachment_Path = VBA.UCase(Sheet1.Range("L5").Value)
    If VBA.InStr(Attachment_Path, FileExtn) > 0 Then Attachment_Path = VBA.Replace(Attachment_Path, FileExtn, "")
   
    If Sheet1.SendRangeFLAG.Value = True Then
    'RANGE TO BE CONVERTED TO PDF
        Sheet1.Range("A1:I23").ExportAsFixedFormat xlTypePDF, Filename:=Attachment_Path
    End If

End If

With myMail.Configuration.Fields
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = SMTPServer
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = ServerPort
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = Login_EmailAddress
    .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = Login_EmailPassword
    .Update
End With

With myMail
    .From = Login_EmailAddress
    .Subject = Email_Subject
    .To = To_Email
    .CC = CC_Email
    .BCC = BCC_Email
    .TextBody = Email_Subject
    If Attachment_Path <> "" Then .AddAttachment Attachment_Path & FileExtn
End With

On Error Resume Next
myMail.Send

If Err.Number <> 0 Then
  MsgBox Err.Description, vbCritical
Else
  MsgBox ("Mail has been sent"), vbInformation
End If

Set myMail = Nothing

End Sub

No comments:

Post a Comment

Note: Only a member of this blog may post a comment.