Macro para enviar correos mediante Outlook con datos adjuntos
Para dante amor
Dante, la macro "correo5b.xlsm" no me funciona, ya que a la hora de ejecutarlo me da error "to". Probé todas las recomendaciones hechas en otra pregunta, sobre tu mismo archivo pero sin éxito.
Mi version de Office es 2013 - Utilizo outlook y mi correo es Gmail IMAP.
1 Respuesta
H ol a: Es un detalle de la versión. Prueba con esta:
[code]'***Macro Para enviar correosSub correo()
'Por.Dante Amor
col = Range("H1").Column
For i = 2 To Range("B" & Rows.Count).End(xlUp).Row
Set dam = CreateObject("outlook.application").createitem(0)
dam.To = Range("B" & i).Value 'Destinatarios
dam.CC = Range("C" & i).Value 'Con copia
dam.Bcc = Range("D" & i).Value 'Con copia oculta
dam.Subject = Range("E" & i).Value '"Asunto"
dam.body = Range("F" & i).Value '"Cuerpo del mensaje"
'
For j = col To Cells(i, Columns.Count).End(xlToLeft).Column
archivo = Cells(i, j).Value
If archivo <> "" Then dam.Attachments.Add archivo
Next
dam.send 'El correo se envía en automático
'dam.display 'El correo se muestra
Next
MsgBox "Correos enviados", vbInformation, "
Dante
Al insertar el código, me da este mensaje, ¿cómo debo proceder?.
Soy muy principiante en esto de las macros, te pido disculpas por las molestias.
Por favor, indicarme como proseguir para que surja efecto, ya que quizás haya algún procedimiento u opción que este haciéndolo mal.
De nuevo, disculpas por las molestias ocasionadas.
No te preocupes, lo que pasa es que la página tiene fallas y no copió el código adecuadamente.
Te lo vuelvo a poner:
Sub correo()
'Por.Dante Amor
col = Range("H1").Column
For i = 2 To Range("B" & Rows.Count).End(xlUp).Row
Set dam = CreateObject("outlook.application").createitem(0)
dam.To = Range("B" & i).Value 'Destinatarios
dam.CC = Range("C" & i).Value 'Con copia
dam.Bcc = Range("D" & i).Value 'Con copia oculta
dam.Subject = Range("E" & i).Value '"Asunto"
dam.body = Range("F" & i).Value '"Cuerpo del mensaje"
'
For j = col To Cells(i, Columns.Count).End(xlToLeft).Column
archivo = Cells(i, j).Value
If archivo <> "" Then dam.Attachments.Add archivo
Next
dam.send 'El correo se envía en automático
'dam.display 'El correo se muestra
Next
MsgBox "Correos enviados", vbInformation, "CORREOS"
End Sub
Fantástico! Me funciono tal cual!. La verdad que no tengo palabras para agradecerte!
Quería pedirte una cosa más, si es posible (perdón por la confianza).
¿Cómo se podría hacer para agregar la firma al final de los mensajes?.(La firma del emprendimiento).
De nuevo muchas gracias!
Sebastián!
Prueba con esta:
Sub correo()
'Por.Dante Amor
col = Range("H1").Column
For i = 2 To Range("B" & Rows.Count).End(xlUp).Row
Set dam = CreateObject("outlook.application").createitem(0)
dam.To = Range("B" & i).Value 'Destinatarios
dam.CC = Range("C" & i).Value 'Con copia
dam.Bcc = Range("D" & i).Value 'Con copia oculta
dam.Subject = Range("E" & i).Value '"Asunto"
cuerpo = Range("F" & i).Value '"Cuerpo del mensaje
'
For j = col To Cells(i, Columns.Count).End(xlToLeft).Column
archivo = Cells(i, j).Value
If archivo <> "" Then dam.Attachments.Add archivo
Next
dam.display 'El correo se muestra
dam.HtmlBody = cuerpo & dam.HtmlBody
dam.display
dam.send 'El correo se envía en automático
'
Next
MsgBox "Correos enviados", vbInformation, "CORREOS"
End Sub
