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.