How can I make my VBA code send a gmail on mac? (Currently using CDO but only works on windows)

[afoley91]

I have setup a file that automatically generates emails and sends them directly from gmail account. Unfortunately I only know how to do this using the CDO reference which is not available for MAC users. I need my code to work for both windows and mac user. Does anybody know how to do this please?

Option Explicit


Sub SendResponses()
'Dim OutApp, OutMail As Object
Dim LastRow, ContRow As Long '
Dim Email, Subj, Mesg, Name, Persons, Bring, Attend As String
Dim SendType As Integer
Dim Mail As CDO.Message
Set Mail = New CDO.Message




'Enable SSL Authentication
   Mail.Configuration.Fields.Item _
   ("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True


   'Make SMTP authentication Enabled=true (1)
   Mail.Configuration.Fields.Item _
   ("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1


   'Set the SMTP server and port Details
   'Get these details from the Settings Page of your Gmail Account
   Mail.Configuration.Fields.Item _
   ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = _
   "smtp.gmail.com"
   Mail.Configuration.Fields.Item _
   ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
   Mail.Configuration.Fields.Item _
   ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2


   'Set your credentials of your Gmail Account
   Mail.Configuration.Fields.Item _
   ("http://schemas.microsoft.com/cdo/configuration/sendusername") = _
   Worksheets("Account Info").Range("B1").Value
   Mail.Configuration.Fields.Item _
   ("http://schemas.microsoft.com/cdo/configuration/sendpassword") = _
   Worksheets("Account Info").Range("B2").Value


   'Update the configuration fields
   Mail.Configuration.Fields.Update


With Sheet2
LastRow = .Range("D9999").End(xlUp).Row   'Last Row
SendType = .Range("B5").Value 'Send Type True/False


For ContRow = 11 To LastRow
    If .Range("K" & ContRow).Value <> Empty Then GoTo NextCont
        Name = .Range("E" & ContRow).Value 'Name
        Attend = .Range("F" & ContRow).Value 'Attend?
        Persons = .Range("G" & ContRow).Value '# of Persons
        Bring = .Range("H" & ContRow).Value 'Bring What
        Email = .Range("J" & ContRow).Value 'Email
        If Attend = .Range("E2").Value Then 'Response 1
            Subj = .Range("E3").Value 'Subject
            Mesg = .Range("E4").Value 'Message
        Else: 'Respnse 2
            Subj = .Range("I3").Value 'Subject
            Mesg = .Range("I4").Value 'Message
        End If
        Subj = Replace(Replace(Replace(Subj, "#Name#", Name), "#Persons#", Persons), "#Bring#", Bring)
        Mesg = Replace(Replace(Replace(Mesg, "#Name#", Name), "#Persons#", Persons), "#Bring#", Bring)
                   ' Set OutApp = CreateObject("Outlook.Application")
                    ' Set OutMail = OutApp.CreateItem(0)
                       'Set All Email Properties
   With Mail
      .To = Email
      .From = Worksheets("Account Info").Range("B1").Value
      .Subject = Subj
      .TextBody = Mesg
   ' If SendType = True Then .Display Else: .Send  'Dispaly or Send Based On Option Box
    On Error GoTo 0
   End With
   'to send the mail
   Mail.Send
                       
            'Add To Log
            .Range("K" & ContRow).Value = Now 'Enter Current Time & Date
NextCont:
 Next ContRow
End With
'ThisWorkbook.Close True
End Sub

 

[RoryA]

Please take a minute to remind yourself of the forum rules on cross-posting and then update your thread to add the appropriate link(s). Thanks.