Macro para enviar por correo electrónico
Para que responda a ser posible el experto Dante Amor o subsidiariamente para Elsa Matilde
El siguiente código me da problemas:
Sub Send_Msg()
ActiveWorkbook.Save
Dim objOL As New Outlook.Application
Dim objMail As MailItem
Set objOL = New Outlook.Application
Set objMail = objOL.CreateItem(olMailItem)
'indica aquí dónde y cómo se llama el archivo a enviar.
AttachmentPath = "C:\Usuarios\pc\documents\proyectoanual-master-1x"
With objMail
.To = "[email protected]" ' cambia a la lista de destinatarios de correo que desees (o a uno solo)
.Subject = "Resumen ventas"
. Body = "Actualización periódica de ventas" 'Puedes capturarlo de una celda o tipearlo directamente.
'adjunta archivo
If Not IsMissing(AttachmentPath) Then
Set objOutlookAttach = .Attachments.Add(AttachmentPath)
Else
MsgBox "Problema con el path"
End If
.Send
End With
Set objMail = Nothing
Set objOL = Nothing
MsgBox "Mail enviado"
End Sub
Se ha producido el error '-2147319779 (8002801d)' en tiempo de ejecución:
Error de Automatización
La biblioteca de objetos no está registrada
Activé la biblioteca Microsoft Outlook 12.0 Object Library desde Visual Basic "Herramientas-Referencias" pero ni aún así.
2 Respuestas
Te anexo una macro para enviar un archivo.
Revisa que la ruta y el nombre estén correctos, el nombre del archivo deberá tener extensión.
Sub Send_Msg()
'Por.Dante Amor
ActiveWorkbook.Save
archivo = "C:\Usuarios\pc\documents\proyectoanual-master-1x.xlsx"
If Dir(archivo) = "" Then
MsgBox "El archivo no existe", vbCritical
Else
Set dam = CreateObject("outlook.application").createitem(0)
dam.To = "[email protected]"
dam.Subject = "Resumen ventas"
dam.body = "Actualización periódica de ventas"
dam.Attachments.Add archivo
dam.send
End If
End SubSaludos.Dante Amor
No olvides valorar la respuesta.
¡Gracias! Me funciona correctamente aunque me gustaría saber si siempre ha de salir el mensaje en el que se me indica por parte de microsoft outlook en que me avisa de que un programa intenta enviar un correo en su nombre. Si no lo espera haga click en Denegar y compruebe si el programa antivirus está actualizado.
Para mas detalle sobre seguridad del correo electrónico y como evitar esta advertencia haga click en Ayuda.
Me gustaría que se hiciera de forma automática sin que salga dicho mensaje de confirmación-permiso.
Es por la versión de excel que tienes, intenta con 2007 o 2010
Verifica este link que puede ayudarte
https://social.msdn.microsoft.com/Forums/en-US/5cc46156-60e1-4807-af57-e189168222c8/macro-para-envo-de-correo-que-no-funciona?forum=isvvba
Poner toda la información aquí seria como tedioso
Sub Envia_Correo() Dim Destinatario As String Destinatario = "[email protected]" strFileName = ActiveWorkbook.Name & ".xls" Dim objOL As Outlook.Application Dim objMail As MailItem Set objOL = New Outlook.Application Set objMail = objOL.CreateItem(olMailItem) With objMail .To = Destinatario .Subject = " Actualizado: " & ActiveWorkbook.Name .Body = "Fecha: " & Date & " - Hora :" & Time .Attachments.Add ActiveWorkbook.FullName .Send End With Set objMail = Nothing Set objOL = Nothing End Sub
Este te permite adjuntar el archivo con el que estas trabajando sin tener que hacer la búsqueda.
Recuerda Valorar la respuesta, Feliz día.!