question

RicardoEVlezPrez-3041 avatar image
0 Votes"
RicardoEVlezPrez-3041 asked RicardoEVlezPrez-3041 answered

VBA - Can anyone please tell me where to look or what am I doing wrong? Thank you very much!

Sending emails from Excel installed on my machine using Outlook 365 web version. This worked until the company implemented the Microsoft 365 Authenticator. Since then it stops at ".send"
Sub Enviar()
Dim EmailMsg, EmailConf As Object, EmailFields As Variant, sh As Worksheet
Dim Subj, Mess, LastName, FirstName, Team, GameDate, GameTime, GameLocation, Field, Email, Attach As String
Dim ContactRow, LastRow, SentCounter As Long, EmailUsr As String
'
EmailUsr = "JuanDelPueblo@nomail.com"
Set sh = Sheets("Envio")
For ContactRow = 2 To 3
If sh.Range("A" & ContactRow).Value <> Empty Then
'
Set EmailMsg = CreateObject("CDO.Message") 'CDO (Collaboration Data Objects) -Make sure you have the 'CDO For Windows' Library Selected
Set EmailConf = CreateObject("CDO.Configuration")
EmailConf.Load -1 ' Set CDO Source Defaults
Set EmailFields = EmailConf.Fields
With EmailFields
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Item("http://schemas.microsoft.com/cdo/configuration/sendtls") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1 'cdoBasic
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.office365.com"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 'cdoSendUsingPort
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = EmailUsr
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "EntrarPassword"
.Update
End With
'
Email = sh.Range("A" & ContactRow).Value 'In column M you must have the email of each record.
Nombrecompleto = sh.Range("B" & ContactRow).Value
Nombre = sh.Range("C" & ContactRow).Value
Apellido = sh.Range("D" & ContactRow).Value
Nombreapellido = sh.Range("E" & ContactRow).Value
Vacaciones = sh.Range("F" & ContactRow).Value
Enfermedad = sh.Range("G" & ContactRow).Value
Mes = sh.Range("H" & ContactRow).Value
Ano = sh.Range("I" & ContactRow).Value
Vacacionesc = sh.Range("J" & ContactRow).Value
Enfermedadc = sh.Range("K" & ContactRow).Value
Vacacionesd = sh.Range("L" & ContactRow).Value
Enfermedadd = sh.Range("M" & ContactRow).Value
Vacacionescd = sh.Range("N" & ContactRow).Value
Enfermedadcd = sh.Range("O" & ContactRow).Value
Subj = "Prueba de envio de Balance Vacaciones y Enfermedad: " & Mes & " " & Ano & " " & Nombrecompleto
Msg = "NOTA: Esto es una prueba de envio multiple, favor no hacer caso del mismo, pueden borrarlo" & vbNewLine
Msg = vbNewLine & "Saludos " & Nombre & " " & Apellido & "," & vbNewLine & vbNewLine & vbNewLine
Msg = Msg & "Incluyo el balance en horas al cierre del mes de " & Mes & " de " & Ano & vbNewLine
Msg = Msg & " Horas / días disponibles de Vacaciones: " & Vacaciones & " / " & Vacacionesd & vbNewLine
Msg = Msg & " Horas / días disponibles de Enfermedad: " & Enfermedad & " / " & Enfermedadd & vbNewLine & vbNewLine
Msg = Msg & "Horas utilizadas en el mes de " & Mes & " de " & Ano & vbNewLine
Msg = Msg & " Horas / días de Vacaciones: " & Vacacionesc & " / " & Vacacionescd & vbNewLine
Msg = Msg & " Horas / días de Enfermedad: " & Enfermedadc & " / " & Enfermedadcd & vbNewLine & vbNewLine & vbNewLine
Msg = Msg & "Quedo a sus órdenes para aclarar cualquier duda o pregunta que pueda surgir," & vbNewLine & vbNewLine
Msg = Msg & "Juan Del Pueblo" & vbNewLine
Msg = Msg & "HR & Customer Service" & vbNewLine
Msg = Msg & "P: 787.999.999 [268]" & vbNewLine
Msg = Msg & "JuanDelPueblo@nomail.com"
'
With EmailMsg
Set .Configuration = EmailConf
.To = Email
.CC = ""
.BCC = ""
.From = EmailUsr
.Subject = Subj
If Attach <> Empty Then .AddAttachment Attach
.TextBody = Msg
On Error Resume Next
.Send 'this is where it stops
On Error GoTo 0
End With
If Err.Number = 0 Then
SentCounter = SentCounter + 1
End If
End If
Set EmailMsg = Nothing
Set EmailConf = Nothing
Set EmailFields = Nothing
Next ContactRow
MsgBox SentCounter & " Emails have been sent"
End Sub

office-outlook-itprooffice-excel-itprooffice-vba-dev
5 |1600 characters needed characters left characters exceeded

Up to 10 attachments (including images) can be used with a maximum of 3.0 MiB each and 30.0 MiB total.

TvanStiphout avatar image
1 Vote"
TvanStiphout answered

CDO is more than 20 years old. AFAIK it does not support TLS 1.2 or better which is rapidly becoming the standard. You will need to find a more modern way to send emails.
https://docs.microsoft.com/en-us/microsoft-365/compliance/prepare-tls-1.2-in-office-365?view=o365-worldwide

5 |1600 characters needed characters left characters exceeded

Up to 10 attachments (including images) can be used with a maximum of 3.0 MiB each and 30.0 MiB total.

RicardoEVlezPrez-3041 avatar image
0 Votes"
RicardoEVlezPrez-3041 answered

Thanks a lot! I will verify the document to which you refer.

5 |1600 characters needed characters left characters exceeded

Up to 10 attachments (including images) can be used with a maximum of 3.0 MiB each and 30.0 MiB total.