Insertar firma con logo a macro mails automático
Mi pregunta es para Dante Amor, si fuera posible. He encontrado la siguiente macro que está adecuada a lo que busco (yo tengo otra que realiza algo similar que adapté de ron de bruin pero esta está mejor). Necesito insertar una firma con logo, ya que trabajo para una compañía y los mails salen con firma. No he logrado hacerlo. Sí puedo si le inserto un mail en .to y me manejo con el display, pero donde le agrego la condición if o la variabllepara que recorra toda la columna enviando unmail a cada dirección de las celdas, me genera error. La macro de Dante a la que me gustaría insertarle la firma con logo es la siguiente (trabajo con outlook 2013 o 2016)
Private Sub Workbook_Open()
'envía mail
'Por.Dam
Sheets("Task Status").Select
ufila = Range("B" & Rows.Count).End(xlUp).Row
For i = 4 To ufila
If Cells(i, 7) <= Cells(i, 8) Then
Set parte1 = CreateObject("outlook.application")
Set parte2 = parte1.createitem(olmailitem)
para = Cells(i, 10) & ";" & Cells(i, 11) & ";" & Cells(i, 12)
parte2.to = para 'Destinatarios
'parte2.CC = "" 'Con copia
parte2.Subject = "Task Status" '"Asunto"
'"Cuerpo del mensaje"
parte2.body = "Señ@r " & Cells(i, 5) & _
" el trabajo " & Cells(i, 2) & _
" le fue asignado el día " & Cells(i, 6) & _
" y actualmente se encuentra " & Cells(i, 8) & _
". Favor indicar la razón de esta situación."
'parte2. Attachments.Add Ruta & Archivo
parte2. Send 'El correo se envía en automático
'parte2. Display 'El correo se muestra
End If
Next
End Sub
Te anexo la macro actualizada
Cambia en la macro "c:\trabajo\" por la carpeta donde tienes el archivo con la firma y logo.
Cambia "firma.jpg" por el nombre del archivo que tiene la firma y logo
Private Sub Workbook_Open()
'envía mail
'Por.Dante Amor
'
'
Sheets("Task Status").Select
ufila = Range("B" & Rows.Count).End(xlUp).Row
For i = 4 To ufila
If Cells(i, 7) <= Cells(i, 8) Then
Set dam = CreateObject("outlook.application").createitem(olmailitem)
para = Cells(i, 10) & ";" & Cells(i, 11) & ";" & Cells(i, 12)
dam.To = para 'Destinatarios
dam.Subject = "Task Status" '"Asunto"
'
'carpeta y nombre del archivo con el logo
ruta = "c:\trabajo\"
logo = "firma.jpg"
dam.Attachments.Add ruta & logo
'
cuerpo = "Señ@r " & Cells(i, 5) & _
" el trabajo " & Cells(i, 2) & _
" le fue asignado el día " & Cells(i, 6) & _
" y actualmente se encuentra " & Cells(i, 8) & _
". Favor indicar la razón de esta situación." & _
"<br> <br>"
'
dam.HTMLBody = _
"<HTML> " & _
"<BODY>" & _
cuerpo & _
"<img src=cid:" & logo & " height=150 width=275>" & _
"</BODY> " & _
"</HTML>"
'
'dam. Attachments.Add Ruta & Archivo
Dam. Send 'El correo se envía en automático
'dam. Display 'El correo se muestra
End If
Next
End Sub.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
.
Avísame cualquier duda
.
¡Gracias! Dante sos un genio! ...y generoso al compartir esa sabiduría. Agradecida como todos a quienes ayudas. Marina
Disculpas, tTengo que molestarte de nuevo. Tengo 2 inconvenientes:
1-La firma, en yahoo en la compu (no en el celular) cuando me llega el mail me aparece como un archivo adjunto incluso con la extensiòn jpg, en cambio en el celu se muestra como firma.
Por otro lado me sale la firma en el medio, hay forma de alinearla a la izquierda? Yo debo enviar un adjunto pdf, puse otro attachment.add y lo agrega, el único problema es que queda junto al archivo de la firma adjunto (en yahoo).
2- En el cuerpo del mail, no me deja agregar espacios cuando le agrego & vbNewLine
Muchas Gracias!!! Marina
Dante ya lo logre hacer.. Compart: .los espacios con <P>, el centrado con align y lo de la imagen que no la muestre con PropertyAccessor.
Gracias igualmente!
Puedes poner el código final
¿Lo de "PropertyAccessor" es el configuración de yahoo?
Hola Dante va el código final. Más que agradecida siempre con tu sabiduría y aportes. Saludos, Marina
Sub MailsMV()
Dim oApp As Outlook.Application
Dim oEmail As MailItem
Dim colAttach As Outlook.Attachments
Dim oAttach As Outlook.Attachment
Dim olkPA As Outlook.PropertyAccessor
Const PR_ATTACH_CONTENT_ID = "http://schemas.microsoft.com/mapi/proptag/0x3712001F"
Sheets("Hoja1").Select
ufila = Range("B" & Rows.Count).End(xlUp).Row
On Error Resume Next
For i = 11 To ufila
para = Cells(i, 2)
Set oApp = CreateObject("Outlook.Application")
Set oEmail = oApp.CreateItem(olMailItem)
Set colAttach = oEmail.Attachments
Set oAttach = colAttach.Add("C:\Users\Desktop\Firma.jpg")
Set olkPA = oAttach.PropertyAccessor
Msg = "Sr. Socio:<P> "
(se agrega texto deseado)
olkPA.SetProperty PR_ATTACH_CONTENT_ID, "Firma.jpg"
oEmail.Close olSave
oEmail.HTMLBody = Msg & "<BODY><IMG src=""cid:Firma.jpg""> </BODY>"
oEmail.Save
' obody = Msg
oEmail.To = para '"[email protected]"
oEmail.Subject = "Indice de Producción Industrial PYME (IPIP)- Agosto 2017"
oEmail.Send
Set oEmail = Nothing
Set colAttach = Nothing
Set oAttach = Nothing
Set oApp = Nothing
Next
End Sub
Sub MailSign()
Dim oApp As Outlook.Application
Dim oEmail As MailItem
Dim colAttach As Outlook.Attachments
Dim oAttach As Outlook.Attachment
Dim olkPA As Outlook.PropertyAccessor
Const PR_ATTACH_CONTENT_ID = "http://schemas.microsoft.com/mapi/proptag/0x3712001F"
Sheets("Hoja1").Select
ufila = Range("B" & Rows.Count).End(xlUp).Row
On Error Resume Next
For i = 11 To ufila
para = Cells(i, 2)
Set oApp = CreateObject("Outlook.Application")
Set oEmail = oApp.CreateItem(olMailItem)
Set colAttach = oEmail.Attachments
Set oAttach = colAttach.Add("C:\Users\Firma.jpg")
Set olkPA = oAttach.PropertyAccessor
Msg = "Estimado Socio:<P> "
'(va el texto)
olkPA.SetProperty PR_ATTACH_CONTENT_ID, "Firma.jpg"
oEmail.Close olSave
oEmail.HTMLBody = Msg & "<BODY><IMG src=""cid:Firma.jpg""> </BODY>"
oEmail.Save
' obody = Msg
oEmail.To = para
oEmail.Subject = "lo q sea"
oEmail.Send
Set oEmail = Nothing
Set colAttach = Nothing
Set oAttach = Nothing
Set oApp = Nothing
Next
End Sub
Dante!, ayuda, te respondí 2 veces, ¿necesito borrarla primera pregunta ya que se me filtro mail etc. Como hago?
La única forma es borrando toda la pregunta.
Si gustas borra toda la pregunta y creas una nueva para poner mi macro y también tu macro.
En el cuerpo de la pregunta escribe para "Dante Amor"
