Trying to Send Email via VBA

Guard913

Board Regular
Joined
Apr 10, 2016
Messages
144
Office Version
  1. 2016
  2. 2010
Platform
  1. Windows
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)

VBA Code:
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!!
 

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
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".
Snag_1b5b2d4b.png


VBA Code:
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
 
Upvote 0
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!
 
Upvote 0
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.
VBA Code:
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
 
Upvote 0
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.
 
Upvote 0
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!!
 
Upvote 0

Forum statistics

Threads
1,213,497
Messages
6,114,002
Members
448,543
Latest member
MartinLarkin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top