Help with CDO

[andrewb90]

Hello all,


I am trying to be able to send mail using CDO, and am very much over my head for my current skill level. Any help would be greatly appreciated. Here is what I have so far, but I keep getting syntax errors.

Sub emailtest()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 = "Results from Excel Spreadsheet"
strFrom = "zaxbys52401@gmail.com"
strTo = "zaxbys52401@gmail.com"
strCc = ""
strBcc = ""
strBody = "The total results for this quarter are: " & Str(Emails.Cells(2, 1))






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/smtpusessl") = True
    .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/sendusing") = 2
    'Put your server name below
   .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.Gmail.Com"
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
    .Update


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

 

[wynn89]

Hi,

you may like to try this:

[COLOR=#3366CC]Sub SendEmailCDO()[/COLOR]    Dim iMsg As Object
    Dim iConf As Object
    Dim strbody As String
    [COLOR=black]'    Dim Flds As Variant[/COLOR]

    Set iMsg = CreateObject("CDO.Message")
    Set iConf = CreateObject("CDO.Configuration")

  [COLOR=black]  '    iConf.Load -1    ' CDO Source Defaults
    '    Set Flds = iConf.Fields
    '    With Flds
    '        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    '        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") _
    '                       = "Fill in your SMTP server here"
    '        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
    '        .Update
    '    End With[/COLOR]

    strbody = "Hi there" 

    With iMsg
        Set .Configuration = iConf
        .To = "insert email address"
        .CC = ""
        .BCC = ""
        .From = "insert your email address<ron@something.nl>"
        .Subject = "your subject"
        .TextBody = strbody
        .Send
    End With
 </ron@something.nl>[COLOR=#3366CC]End Sub [/COLOR]

Regards,
Wynn

 

[andrewb90]

Hi, I got an error: "The Send Using configuration value isn't valid. I have no idea what that means.

 

[Kenneth Hobson]

Notice the port settings.

Sub Test_Gmail()
  Gmail "ken@gmail.com", "ken", "Hello World!", _
    "This is a test using CDO to send Gmail with an attachement.", _
    "khobson@somewhere.org", "YourFriendlyNeighborhoodSpiderman@spidey.com", _
    "x:\test\test.xlsm"
End Sub

' http://www.blueclaw-db.com/access_email_gmail.htm
' http://msdn.microsoft.com/en-us/library/ms872547%28EXCHG.65%29.aspx
' Add CDO reference for early binding method
'  Tools > References > Microsoft CDO for Windows 2000 Library
'    c:\windows\system32\cdosys.dll
' http://www.rondebruin.nl/cdo.htm  'Other cdo tips for cdo to Outlook from Excel
Function Gmail(sendUsername As String, sendPassword As String, subject As String, _
  textBody As String, sendTo As String, sendFrom As String, _
  Optional sAttachment As String = "")
  
  'Dim cdomsg as Object 'late binding method
  ' Set cdomsg = CreateObject("CDO.message")  'late binding method
  Dim cdomsg As New CDO.Message  'early binding method
  With cdomsg.Configuration.Fields
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 'NTLM method
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
    .Item("http://schemas.microsoft.com/cdo/configuration/smptserverport") = 587
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = sendUsername
    .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = sendPassword
    .Update
  End With
  ' build email parts
  With cdomsg
    .To = sendTo
    .From = sendFrom
    .subject = subject
    .textBody = textBody
    If Dir(sAttachment) = "" Then sAttachment = ""
    If sAttachment <> "" Then .AddAttachment (sAttachment)
    .Send
  End With
  Set cdomsg = Nothing
End Function

 

[andrewb90]

Hi Kenneth,

Sorry about the late reply, I've been so busy lately haven't had much time to work on Excel. Looking at your code made me realize how far I still have to go in terms of Excel Proficiency I am not entirely sure where to enter my gmail information for sending and receiving though. I tried to change the send from and that clearly didn't work. Btw, would I be able to specify multiple BCC from a cell range?

 

[Kenneth Hobson]

Once you add (1), you can use my function just like you would any built-in function.

1. Set the CDO reference as I commented.
2. In the test Sub, the replace the first input value with your gmail login email.
3. Replace the 2nd input value with your password for gmail.
4. Replace the subject string that I used or leave it as is for testing.
5. Replace the value of the body string with yours or leave as is for testing.
6. Replace the sendTo and sendFrom strings that I passed to yours or leave as is.
7. The last input string to pass in Test sub can be deleted as it is optional. It is the string path to a file to attach.

Once you get it working, I can show you how to build the string of delimited emails from the range values.

 

[andrewb90]

Thank you so much for your help so far. I got it to send emails! (Google blocked me and I had to find the security settings and allow unsecured access first though)
Ideally I would like to take a column of cells B7:B25, and C7:C25 and email to those addresses and pdf copy of one of the sheets in my workbook.
I have a printing function setup that when I go to print I create a pdf copy of selected cell ranges and the file location is always the same, but the name of the file will change each time.

One other thing that I hope will not be difficult, is that the range where I have email addresses will not all contain values, so naturally I would want those lines to be skipped.

 

[Kenneth Hobson]

Is a PDF file specific to each unique email address? No sense showing how to send all at once if one at a time for the filled ranges is what you want.

 

[andrewb90]

My current plan is to send the same pdf file to each email address. Long term I would prefer to be able to just have the message body include the contents of select cells, but I figured that would be far too difficult, but if both are possible that would be cool.


To fill you in a bit more:
if I can get this sheet just the way I want it, I can send each employee their individual work schedule in the body of the email, and then send the complete schedule to the managers and supervisors as a pdf. I just wanted to work at it step by step.

thanks for all your help so far!

 

[Kenneth Hobson]

'http://www.rondebruin.nl/win/s1/cdo.htm
'http://www.learnexcelmacro.com/wp/2011/12/how-to-send-an-email-using-excel-macro-from-gmail-or-yahoo/
'https://www.youtube.com/watch?v=pFl7W8d7d4M
'http://www.blueclaw-db.com/access_email_gmail.htm

'cdo methods and properties or options, those shown by early binding but more detail:
'https://msdn.microsoft.com/en-us/library/ms872547%28EXCHG.65%29.aspx?f=255&MSPPError=-2147217396

Sub Main()
  Dim r As Range, c As Range
  Dim sTo As String
  
  Set r = Worksheets("Sheet1").Range("B7:C25")
  For Each c In r
    With c
      If InStr(.Value2, "@") <> 0 Then sTo = sTo & "," & .Value2
    End With
  Next c
  
  If sTo = "" Then
    MsgBox sTo, vbCritical, "Ending Macro - Missing email(s)"
    Exit Sub
  End If
  
  sTo = Right(sTo, Len(sTo) - 1)
  
  Gmail "ken@gmail.com", "Ken", _
    "Subject", _
    "Body", _
    sTo, _
    "noone@nowhere.com"
End Sub


' http://www.blueclaw-db.com/access_email_gmail.htm
' http://msdn.microsoft.com/en-us/library/ms872547%28EXCHG.65%29.aspx
' Add CDO reference for early binding method
'  Tools > References > Microsoft CDO for Windows 2000 Library
'    c:\windows\system32\cdosys.dll
' http://www.rondebruin.nl/cdo.htm  'Other cdo tips for cdo to Outlook from Excel

'CDO to gmail requires lowering your security:
'https://myaccount.google.com/security#connectedapps
'at the end set, Allow less secure apps: ON

Function Gmail(sendUsername As String, sendPassword As String, subject As String, _
  textBody As String, sendTo As String, sendFrom As String, _
  Optional sAttachment As String = "")
  
  Dim cdomsg As New CDO.Message  'early binding method
  'set cdomsg=new CDO.Message 'early binding only
  'Dim cdomsg As Object 'late binding method
  Set cdomsg = CreateObject("CDO.message")  'late binding method or early binding
 
  With cdomsg.Configuration.Fields
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 'NTLM method
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
    .Item("http://schemas.microsoft.com/cdo/configuration/smptserverport") = 25  '25 or 587
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = sendUsername
    .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = sendPassword
    .Update
  End With
  ' build email parts
  With cdomsg
    .To = sendTo
    .From = sendFrom
    .subject = subject
    .textBody = textBody
    '.BCC
    '.CC
    '.ReplyTo = sendFrom
    '.HTMLBody
    '.HTMLBodyPart
    If Dir(sAttachment) = "" Then sAttachment = ""
    If sAttachment <> "" Then .AddAttachment (sAttachment)
    .Send
  End With
  Set cdomsg = Nothing
End Function