Using Excel VBA to send emails from my Gmail account

[ABabeNChrist]

It feels good to be back thank you

A stripped-down version would be very helpful

[DocAElstein]

Hi
OK, so I have stripped down to about as naked as I like to go, ( and included the bit from Hans to select a file or files to attach)
( As usual I will pass you the workbook, ( TheNakedTexasRanger_CDOSendMail.xls ) , the thing with real Emails accounts , per private message. - , all configuration data including the username and passwords is real and its ready to run, so as ever, be careful who gets hold of it or sees it!)

I have done the same 3 basic macros as before, just stripped them down a bit

Public Function TexasRange(___ is the main thing that does it all

Code: Select all

 '   https://eileenslounge.com/viewtopic.php?f=27&t=38916&start=40
'                            "sendusername"     ,     "sendpassword"    ,       "smtpusessl"        ,         "smtpauthenticate"  ,   "smtpserver"             , "sendusing"                 ,  "smtpserverport"             ,  "smtpconnectiontimeout"
Public Function TexasRange(ByVal UsrNme As String, ByVal PssWrd As String, ByVal SlutPussly As String, ByVal PatheticCake As String, ByVal ServiceChef As String, ByVal WayntkerUsed As String, ByVal ConnectingDoor As String, ByVal WaitSecs As String, ByVal Snd_Frm As String) As Boolean
 Let TexasRange = False ' We call this false until a sucesful  .Send  has ocurred.    Probably don't need to do this here
   With CreateObject("CDO.Message") '
   Dim LCD_CW As String: Let LCD_CW = "http://schemas.microsoft.com/cdo/configuration/" '
    .Configuration(LCD_CW & "smtpusessl") = SlutPussly ' ' '
    .Configuration(LCD_CW & "smtpauthenticate") = PatheticCake  '
   '  ' Sever info
    .Configuration(LCD_CW & "smtpserver") = ServiceChef   '
    .Configuration(LCD_CW & "sendusing") = WayntkerUsed  '
    .Configuration(LCD_CW & "smtpserverport") = ConnectingDoor  '
    .Configuration(LCD_CW & "sendusername") = UsrNme   '
    .Configuration(LCD_CW & "sendpassword") = PssWrd
    .Configuration(LCD_CW & "smtpconnectiontimeout") = WaitSecs '
    .Configuration.fields.Update '
   .To = Worksheets.Item(1).Range("A1").Value2 'Main email address to send to
   .CC = "TheNakedTexasRanger@t-online.de" ' You can have as many  .CC   as you want
   '.CC = "invalidInspectings@yooohoo.usa"
   .BCC = ""
   .From = """ABabeNChrist"" <" & Snd_Frm & ">" '
   '.Subject = "Hello from " & UsrNme & ""    '
   .Subject = "Hello from " & Left(UsrNme, InStr(1, UsrNme, "@", vbBinaryCompare) - 1)
   .TextBody = "Hi " & ThisWorkbook.Worksheets.Item(1).Range("A1").Value2 & vbCr & vbLf & ThisWorkbook.Worksheets.Item(1).Range("A3").Value
   'select the file(s) to send with the microsoft file dialog box
    Dim dlgFile As FileDialog, strItem As Variant '   https://eileenslounge.com/viewtopic.php?p=300925#p300925
     Set dlgFile = Application.FileDialog(msoFileDialogFilePicker)
     dlgFile.AllowMultiSelect = True
        If dlgFile.Show Then
          For Each strItem In dlgFile.SelectedItems
          .AddAttachment strItem
          Next strItem
        End If
    On Error GoTo Bed   ' Intended to catch a possible predicted error in the next line when running the routine
    .send
    On Error GoTo 0     ' Not expecting any error, so return to default error handling
    End With ' CreateObject("CDO.Message")
MsgBox Prompt:="Email creation worked  with  " & """" & UsrNme & """"
 Let TexasRange = True ' For a normal macro ending, we probably were sucessful, so the return of this  True  via the
Exit Function                                                                                     ' Normal routine end for no error exceptional errected situation
Bed:                                                                                                    ' Intended to catch an error when running the routine

MsgBox Prompt:="Email creation failed! with  " & """" & UsrNme & """" & "   Error is " & Err.Number & ": " & Err.Description
' On Error GoTo -1: On Error GoTo 0 ' Do not need to do this as the code is ending
End Function

The other two macros are the two options to pass the information for the Email account that sends the Email. (Either of those is the macro you run )
_ - see next post

[DocAElstein]

These are the two options you have to Call the main function given in the last post. So either of these is the one you run.

Sub TestCall_TexasRangeCDOSendMailAttempt() just tries one account. The configuration parameters here are based on what our experiments suggested are most likely to work for a g mail account. So you just need to change the first two and last parameters which are
_ the Email name part before the @gmail.com ( in two places – at the first and last configuration parameters)
_ the second configuration parameter, which, (since May this year), for a gmail account, must be the 16 character App password
( In other words, the Email name part before the @______ and the password need to be changed for the gmail account that you want to use, but the rest of the configuration parameters are what we found to be correct for the Email provider gmail )

Code: Select all

 Sub TestCall_TexasRangeCDOSendMailAttempt() '      '  https://eileenslounge.com/viewtopic.php?p=301323#p301323
Dim Cunfigarations As String  '  CDO Account configurations,   "sendusername" "sendpassword" "smtpusessl" "smtpauthenticate" "smtpserver" "sendusing" "smtpserverport" "smtpconnectiontimeout"   ,   each one  seperated by vbCr & vbLf
 Let Cunfigarations = "xxxxxxz@gmail.com wwwwxxxxyyyyzzzz True 1 smtp.gmail.com 2 465 30 xxxxxxz@gmail.com"
Rem 2 pass the config parameters to  Function TexasRange(___
Dim CunFik() As String: Let CunFik() = Split(Cunfigarations, " ", 9, vbBinaryCompare)
    Call TexasRange(CunFik(0), CunFik(1), CunFik(2), CunFik(3), CunFik(4), CunFik(5), CunFik(6), CunFik(7), CunFik(8))
End Sub

_._________________________________________________________________



Sub TestCall_TexasRangeCDOSendMailAttemptS() allows you to try a few accounts until one works.
( In the forum openly posted version here example below, The first two and last configuration parameters, for all 9 Email accounts need to be changed: , so The Email name part before the @______ ( in the first and last configuration parameter) and the password ( second configuration parameter) need to be changed for the real ones that you want to try to use, but the rest of the configuration parameters are what we found to be correct for the corresponding Email provider. In other words, the rest of the configuration parameters are what we found to be correct for the corresponding bit after the @______ in the first (and last ) configuration parameter
( In the workbook I pass per private message, all configuration data is real and its ready to run, but you might want to change some and/ or re arrange the order)

Code: Select all

 Sub TestCall_TexasRangeCDOSendMailAttemptS() ' ' https://eileenslounge.com/viewtopic.php?p=301323#p301323
Rem 0 ' Cunfigarations
Dim Cunfigarations As String  '  CDO Account configurations,   "sendusername" "sendpassword" "smtpusessl" "smtpauthenticate" "smtpserver" "sendusing" "smtpserverport" "smtpconnectiontimeout"   ,   each one  seperated by vbCr & vbLf
 Let Cunfigarations = "xxxxxxx@gmail.com wwwwxxxxyyyyzzzz True 1 smtp.gmail.com 2 465 30 xxxxxxx@gmail.com"
 Let Cunfigarations = Cunfigarations & vbCr & vbLf & "nakedranger@yandex.com sdgsgddgasjkhg True 1 smtp.yandex.com 2 465 30 nakedranger@yandex.com"
 Let Cunfigarations = Cunfigarations & vbCr & vbLf & "thenakedranger@yandex.com Striper* True 1 smtp.yandex.com 2 465 30 thenakedranger@yandex.com"
' Let Cunfigarations = Cunfigarations & vbCr & vbLf & ""
 Let Cunfigarations = Cunfigarations & vbCr & vbLf & "yyyyytasty@gmail.com wwwwxxxxyyyyzzzz True 1 smtp.gmail.com 2 465 3 yyyyytasty@gmail.com"
' Let Cunfigarations = Cunfigarations & vbCr & vbLf & ""
 Let Cunfigarations = Cunfigarations & vbCr & vbLf & "cdodevelopments@yandex.com dfkjsdfdnsd True 1 smtp.yandex.com 2 465 3 cdodevelopments@yandex.com"
' Let Cunfigarations = Cunfigarations & vbCr & vbLf & ""
 Let Cunfigarations = Cunfigarations & vbCr & vbLf & "nakedranger@Outlook.de NakedTruth True 1 smtp-mail.outlook.com 2 25 30 nakedranger@outlook.de"
 Let Cunfigarations = Cunfigarations & vbCr & vbLf & "Jaymy@t-online.de JayMySend True 1 securesmtp.t-online.de 2 465 3 Jaymy@t-online.de"
' Let Cunfigarations = Cunfigarations & vbCr & vbLf & ""
 Let Cunfigarations = Cunfigarations & vbCr & vbLf & "TheTexasStriper@t-online.de StriperSending True 1 securesmtp.t-online.de 2 465 3 TheTexasStriper@t-online.de"
' Let Cunfigarations = Cunfigarations & vbCr & vbLf & ""
 Let Cunfigarations = Cunfigarations & vbCr & vbLf & "CDOTests@t-online.de PrgSendPassword True 1 securesmtp.t-online.de 2 465 3 CDOTests@t-online.de"

Dim VlagaMir As Boolean ' This is set to True after an EMail is succcesful

Rem 1 make array for the configutration parameters of all EMail accounts
Dim SptACnt() As String: Let SptACnt() = Split(Cunfigarations, vbCr & vbLf, -1, vbBinaryCompare)
Rem 2 pass the config parameters to   Function TexasRange(___     until successful mail send
Dim Cnt As Long
   For Cnt = 0 To UBound(SptACnt())
   Dim CunFik() As String: Let CunFik() = Split(SptACnt(Cnt), " ", 9, vbBinaryCompare)
    Let VlagaMir = TexasRange(CunFik(0), CunFik(1), CunFik(2), CunFik(3), CunFik(4), CunFik(5), CunFik(6), CunFik(7), CunFik(8))
       If VlagaMir = True Then Exit Sub ' Comment this line out and all Email addresses will be tried
   Next Cnt
End Sub

_._________________-




Alan


_.________________-

( Latest Workbook, TheNakedTexasRanger_CDOSendMail.xls , sent by private message )

[ABabeNChrist]

Thank you so much Alan you have been very helpful . I will look it over sometime today (I'm a little under the weather ) and will let you know how it goes tomorrow.

[ABabeNChrist]

Update: So far, I am having great success, I am going to do some tweaking with the code in the next couple of days so I can use a UserForm to select the ".Subject" and the ".TextBody" verbiage I want to use. Quit often I send out a variety of different email messages, so I'm hoping this will save some steps and be a little more efficient.

[DocAElstein]

Good News, thanks for the feedback.

(Just out of interest, did you get your main gmail account to work to send Emails )

( by the way, I noticed also that you use a yahoo.com account. I have never managed to get a yahoo.com account to work to send Emails in any of my CDO send mail codings. This might be due to one or more reasons, such as that I have never managed to get the correct configurations, and/ or perhaps for some security reason they don’t want any accounts that I have made to send Emails in coding
The configuration data that I thought might work , but never has worked for me, is
"smtpusessl" "True"
"smtpauthenticate" "1"
"smtpserver" "smtp.mail.yahoo.com"
"sendusing" "2"
"smtpserverport" "465"
"smtpconnectiontimeout" "30"
In the format I use in the codings that would then be something like

Code: Select all

 Let Cunfigarations = "invalidinfections@yahoo.com xxxxxxxx True 1 smtp.mail.yahoo.com 2 465 30 invalidinfections@yahoo.com"

for the Sub TestCall_TexasRangeCDOSendMailAttempt()
Those are what you would use if you wanted to try your luck with your yahoo.com account as the Email sender, but I expect it would not work )

[ABabeNChrist]

Thanks Alan, I was able to send emails perfectly using my business Gmail account. I never did try any others email accounts, but I am curious....
So far using a UserForm is going great....