| Pregunta: | 58355 - EXCEL QUE MANDE UN ARCHIVO POR CORREO A OUTLOOK |
| Autor: | Eduardo Arrieta |
| Hola buen dia, estoy tratando de hacer una macro que en Excel que mande un archivo por correo a Outlook, estoy seguro que incluso le puedes definir la lista de distribución con una BD. Me pueden ayudar de favor | |
| Respuesta: | Gonzalo Quintana |
| Hola Eduardo,
Te paso el siguiente código, probalo y comentame... Sub Macro_Inicio() On Error GoTo Err_Macro_Inicio Dim CUERPO_MENSAJE As String Dim TITULO_MENSAJE As String Dim ADJUNTO_MENSAJE As String Dim EMAIL_LEGAJO As String Application.DisplayAlerts = False 'POSICIONARME EN EL 1ER. LEGAJO Range("A2").Select 'Mientras tenga algun legajo escrito que le envie email While ActiveCell.Offset(0, 0).Value <> "" 'Guardo el nro de legajo NOMBRE_LEGAJO = ActiveCell.Offset(0, 0).Value EMAIL_LEGAJO = ActiveCell.Offset(0, 1).Value CUERPO_MENSAJE = "Buenos días" & Chr(13) & _ "Le hago llegar el informe... " & Chr(13) & _ "Muchas gracias" TITULO_MENSAJE = "Informe Mensual " & NOMBRE_LEGAJO ADJUNTO_MENSAJE = "" 'Dirección del adjunto Call Enviar_Email_Outlook(EMAIL_LEGAJO, _ TITULO_MENSAJE, CUERPO_MENSAJE, ADJUNTO_MENSAJE) 'Me muevo al siguiente legajo ActiveCell.Offset(1, 0).Select Wend 'Avisar que termino de ejecutar Application.DisplayAlerts = True MsgBox "La macro se ejecuto correctamente.", _ vbOKOnly + vbInformation, "Ejecucación Macros" Exit Sub Err_Macro_Inicio: Resume Next End Sub Sub Enviar_Email_Outlook(EMAIL_PARA As String, EMAIL_TITULO As String, EMAIL_CUERPO As String, EMAIL_ADJUNTO As String) Dim OutApp As Object Dim OutMail As Object Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(0) On Error Resume Next With OutMail .To = EMAIL_PARA .CC = "" .BCC = "" .Subject = EMAIL_TITULO .Body = EMAIL_CUERPO 'recorro el directorio del EMAIL_ADJUNTO para agregar cada uno de los archivos .Attachments.Add EMAIL_ADJUNTO .Save 'Lo graba como borrador (sino usar .Send para enviar el email directamente) End With Set OutMail = Nothing Set OutApp = Nothing End Sub Saludos, Gonzalo | |