Existe alguna macro para envió masivo con mismo cuerpo y asusto pero diferente E-mail y adjuntos para office 365 ultima version?

Te anexo la macro para office

Sub EnviarCorreo()
'Por.Dante Amor
    Correo = "[email protected]"     'correo de office
    passwd = "pwd"                      'password del correo
    destino = "usuario@gmailcom"        'correo del destinatario
    '
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    '
    Dim Email As CDO.Message
    Set Email = New CDO.Message
    Email.Configuration.Fields(cdoSMTPServer) = "smtp.office365.com"
    Email.Configuration.Fields(cdoSendUsingMethod) = 2
    With Email.Configuration.Fields
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = CLng(25)
        .Item("http://schemas.microsoft.com/cdo/" & "configuration/smtpauthenticate") = Abs(1)
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = Correo
        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = passwd
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
    End With
    With Email
        .To = destino
        .From = Correo
        .Subject = "Asunto"
        .TextBody = "todo lo que quieras Cuerpo del correo"
        '.AddAttachment "archivo.xlsx"
        .Configuration.Fields.Update
        On Error Resume Next
        .Send
    End With
    If Err.Number = 0 Then
        MsgBox "El mail se envió con éxito"
    Else
        MsgBox "Se produjo el siguiente error: " & Err.Number & " " & Err.Description
    End If
    Set Email = Nothing
End Sub

.

'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias

.

Avísame cualquier duda

.

Dante. Modifiqué el nombre pero me da el siguiente error:

No se si es posible usar el formato del otro thread (Macro para envíar correos masivos con adjuntos diferentes) pero con la version de 365