Option Explicit
Sub SendEmailUsingGmail()
Dim NewMail As Object
Dim mailConfig As Object
Dim fields As Variant
Dim msConfigURL As String
Dim rng As Range
Set rng = Nothing
On Error Resume Next
Set rng = Selection.SpecialCells(xlCellTypeVisible)
On Error GoTo Err:
'late binding
Set NewMail = CreateObject("CDO.Message")
Set mailConfig = CreateObject("CDO.Configuration")
' load all default configurations
mailConfig.Load -1
Set fields = mailConfig.fields
'Set All Email Properties
With NewMail
.Sender = "" 'mail address
.From = "Sourav Bhattacharya"
.To = "" 'mail address
.CC = ""
.BCC = ""
.Subject = "Demo Spreadsheet Attached"
.Textbody = "Let me know if you have questions about the attached spreadsheet!"
.Addattachment "C:\Users\allso\Desktop\new vba projects\temp.jpg"
.HTMLBody = .Textbody
End With
msConfigURL = "http://schemas.microsoft.com/cdo/configuration"
With fields
.Item(msConfigURL & "/smtpusessl") = True 'Enable SSL Authentication
.Item(msConfigURL & "/smtpauthenticate") = 1 'SMTP authentication Enabled
.Item(msConfigURL & "/smtpserver") = "smtp.gmail.com" 'Set the SMTP server details
.Item(msConfigURL & "/smtpserverport") = 465 'Set the SMTP port Details
.Item(msConfigURL & "/sendusing") = 2 'Send using default setting
.Item(msConfigURL & "/sendusername") = "" 'Your gmail address
.Item(msConfigURL & "/sendpassword") = "" 'Your password or App Password
.Update 'Update the configuration fields
End With
NewMail.Configuration = mailConfig
NewMail.Send
MsgBox "Your email has been sent", vbInformation
Exit_Err:
'Release object memory
Set NewMail = Nothing
Set mailConfig = Nothing
End
Err:
Select Case Err.Number
Case -2147220973 'Could be because of Internet Connection
MsgBox "Check your internet connection." & vbNewLine & Err.Number & ": " & Err.Description
Case -2147220975 'Incorrect credentials User ID or password
MsgBox "Check your login credentials and try again." & vbNewLine & Err.Number & ": " & Err.Description
Case Else 'Report other errors
MsgBox "Error encountered while sending email." & vbNewLine & Err.Number & ": " & Err.Description
End Select
Resume Exit_Err
End Sub
Showing posts with label Send gmail using VBA. Show all posts
Showing posts with label Send gmail using VBA. Show all posts
Tuesday, December 8, 2020
Send gmail using VBA with attachment
Subscribe to:
Posts (Atom)