Excel - Macro para enviar un correo desde outlook utilizando excel2016

Sub EnviarEmail()

'

' Declaramos variables

'

Dim OutlookApp As Outlook.Application

Dim MItem As Outlook.MailItem

Dim cell As Range

Dim Asunto As String

Dim Correo As String

Dim Destinatario As String

Dim Saldo As String

Dim Msg As String

'

Set OutlookApp = New Outlook.Application

'

'Recorremos la columna EMAIL

'

For Each cell In Range("B11:B12")

'

'Asignamos valor a las variables

'

Asunto = "Saldo vencido"

Destinatario = cell.Offset(0, -1).Value

Correo = cell.Value

'

'Cuerpo del mensaje

'

Msg = "Allplanet Gestión Integral S.L." & vbNewLine

Msg = Msg & "Departamento de Sistemas y Ciberseguridad" & vbNewLine & vbNewLine

Msg = Msg & "Estimados señores(as);" & vbNewLine & vbNewLine

Msg = Msg & "Nos ponemos en contacto con Vd. para recordarle situación actual del mundo " & vbNewLine

Msg = Msg & "digital y su difícil fórmula de defensa con los medios disponibles para " & vbNewLine

Msg = Msg & "particulares, empresas. " & vbNewLine

Msg = Msg & "Si ya dispone de una Asesoría Digital, Ciberseguridad, etc.…, estaría más " & vbNewLine

Msg = Msg & "completa con una Auditoria de Hardware, Red, Sistemas Operativos y demás " & vbNewLine

Msg = Msg & "componentes, que desde Allplanet le recomendamos. " & vbNewLine & vbNewLine

Msg = Msg & "Nos complacería ser una primera opción para realizar esta operación y el " & vbNewLine

Msg = Msg & "mantenimiento de las instalaciones con el responsable de las mismas, para " & vbNewLine

Msg = Msg & "poder pensar en el mejor funcionamiento, previsiones, necesidades futuras y " & vbNewLine

Msg = Msg & "mayor tranquilidad. Dos puntos de vista siempre son mejor que uno." & vbNewLine & vbNewLine & vbNewLine

Msg = Msg & "En ALLPLANET nos importan mucho nuestros clientes, actuales y futuros." & vbNewLine & vbNewLine & vbNewLine

Msg = Msg & "Nuestro mayor interés sería:" & vbNewLine & vbNewLine

Msg = Msg & "Realizar una Implantación de ciberseguridad" & vbNewLine

Msg = Msg & "Puesta a punto de sus equipos Informáticos" & vbNewLine

Msg = Msg & "Para el mantenimiento de su EMPRESA, OFICINA" & vbNewLine

Msg = Msg & "La actualización de máquinas por equipos actuales." & vbNewLine & vbNewLine & vbNewLine

Msg = Msg & "Estamos a su entera disposición para lo que necesite."

Msg = Msg & FechaVencimiento & "." & vbNewLine & vbNewLine

Msg = Msg & "Muchas gracias." & vbNewLine & vbNewLine & vbNewLine

Msg = Msg & Saldo & vbNewLine & vbNewLine

Msg = Msg & "Departamento de Sistemas y Ciberseguridad" & vbNewLine

Msg = Msg & "Resp: Manuel Vicente" & vbNewLine

Msg = Msg & "soporte@allplanet.es" & vbNewLine

Msg = Msg & "TLF: + 34 *** *** ***"

'

Set MItem = OutlookApp.CreateItem(olMailItem)

With MItem

.To = Correo

.Subject = Asunto

.Body = Msg

.Send

'

End With

'

Next

'

End Sub