Trying to Send Email via VBA

[Guard913]

This is my code so far for gmail (any missing email/password assume I will enter correct one just removed for privacy reasons) Ultimately the hope is to send via my Outlook email, but right now I just want to prove it works via gmail, as gmail is my personal accounts and outlook would be for work... Would rather not send random outlook messages until I have coding 100% down.

When I try to send now, it just gives an error message (transport failed to connect to server)

Sub Send_Email_QSS()
Dim CDO_Mail As Object
Dim CDO_Config As Object
Dim SMTP_Config As Variant
Dim strSubject As String
Dim strFrom As String
Dim strTo As String
Dim strCc As String
Dim strBcc As String
Dim strBody As String

strSubject = Sheets("Emails").Range("A2").Value 'trying to use cell value to fill in missing items'
strFrom = "MyEmail" 'this would end up being the same from email everytime'
strTo = "Email Being Sent To" 'ultimately the hope is to set this to cell value as well, vs the same email address everytime'
strCc = ""
strBcc = ""
strBody = Sheets("Emails").Range("B2").Value

Set CDO_Mail = CreateObject("CDO.Message")
On Error GoTo Error_Handling

Set CDO_Config = CreateObject("CDO.Configuration")
CDO_Config.Load -1

Set SMTP_Config = CDO_Config.Fields

With SMTP_Config
 .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
 .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
 .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
 .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "MyEmail@gmail.com"
 .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "MyPassword"
 .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 587 'found this by going into my email settings'
 .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
 .Update
End With

With CDO_Mail
 Set .Configuration = CDO_Config
End With

CDO_Mail.Subject = strSubject
CDO_Mail.From = strFrom
CDO_Mail.To = strTo
CDO_Mail.TextBody = strBody
CDO_Mail.CC = strCc
CDO_Mail.BCC = strBcc
CDO_Mail.Send

Error_Handling:
If Err.Description <> "" Then MsgBox Err.Description

End Sub

Can someone help? If we get this resolved I will probably back to get help with outlook, but lets focus on this for now!

You guys are awesome!! Thanks!!

 

[VBE313]

Learning how to use it in Outlook will be completely different than learning to use it in Gmail. Using Outlook is easy and safe with using ".Display". that doesn't send any emails. Here is a test for you to run in Outlook. Make sure in VBA Editor you go to Tools > References and turn on "Microsoft Outlook 16.0 Object Library".

Sub Guard913()


Set OutApp = CreateObject("Outlook.Application")

Set OutMail = OutApp.CreateItem(0)

With Sheets("Sheet1") 'CHANGE THIS TO THE SHEET NAME


    With OutMail

        .To = "MrGuard913@mrExcel.com"

        .CC = ""

        .BCC = ""

        .Subject = "Hey"

        '.Attachments.Add ActiveWorkbook.FullName

        .Body = "Hi Guard913,"
       '.HTMLBody is also an option instead of .Body

        .Display

        '.Send      you can send the email without even looking at it

    End With

End With

Set OutMail = Nothing

Set OutApp = Nothing

End Sub

 

[Guard913]

I don't use desktop outlook app, i use the web version of outlook (its not even installed as my job requires us you the web version).... (Also the reference you had me looking for doesn't exist in my list)

It appears the code you have for me requires that I have it installed on my desktop.

Thanks for the alternate idea though!

 

[Ardus Petus]

Gmail SMTP uses port 25.
I re-arranged your code to get rid of all the configuration objects you had. I directly use CDO_Mail.configuration.
I also fixed your error-handling routine which your code falls into.

Option Explicit

Sub Send_Email_QSS()
Dim CDO_Mail As Object
Dim strSubject As String
Dim strFrom As String
Dim strTo As String
Dim strCc As String
Dim strBcc As String
Dim strBody As String

strSubject = "Subject" 'trying to use cell value to fill in missing items'
strFrom = "????????????@gmail.com" 'this would end up being the same from email everytime'
strTo = "xxxx@yyyy.com" 'ultimately the hope is to set this to cell value as well, vs the same email address everytime'
strCc = ""
strBcc = ""
strBody = "Body du message"

Set CDO_Mail = CreateObject("CDO.Message")
On Error GoTo Error_Handling
With CDO_Mail
    With .configuration
        .Load -1
        With .Fields
            .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
            .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "???????????@gmail.com"
            .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "???????????"
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 'found this by going into my email settings'
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
            .Update
        End With
    End With
    .Subject = strSubject
    .From = strFrom
    .To = strTo
    .TextBody = strBody
    .CC = strCc
    .BCC = strBcc
    .Send
End With
Exit Sub

Error_Handling:
    MsgBox Err.Description
End Sub

HTH,
--
AP

 

[Guard913]

It still stops at .Send with error (still unable to connect to server). I jsut coped and pasted your entire code, and then changed the emails/passwords.

 

[Guard913]

I figured this would be a really hard task, to do. And all it is really doing is saving me time from sending 30 diff emails daily manually... I very well could be doing something wrong on my end.

Thanks for Trying!!

 

[Ardus Petus]

What is the exact error message ?