¿ Como hacer una macro que envié correos automáticos en outlook y registre la información del asunto en excel ?
Recibo bastantes correos en mi bandeja de entrada de outlook, los cuales tengo reenviar a otras cuentas de correo y después registrar los datos del asunto y la fecha y hora en que fue enviado en un archivo de excel para llevar una base de control de lo que envió. Por tal motivo quiero una macro en outlook, que al recibir un correo lo reenvié automáticamente y registre la información en el archivo de excel.
1 Respuesta
Te dejo mi FB para que me escribas; Gabriel Nattramn.
Sub CorreoTodoExpertos()
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 Msg As String
Set OutlookApp = New Outlook.Application
For Each cell In Range("B1:B35")
Asunto = "Aquí va tu asunto"
Destinatario = cell.Offset(0, -1).Value
Correo = cell.Value
'Cuerpo del mensaje
Msg = "Aquí va el saludo " & Destinatario & vbNewLine & vbNewLine
Msg = Msg & "Aquí va tu primer línea "
Msg = Msg & "Atentamente: " & vbNewLine
Msg = Msg & "Tu firma "
Set MItem = OutlookApp.CreateItem(olMailItem)
With MItem
.To = Correo
.Subject = Asunto
.Body = Msg
End With
Next
Windows("TodoExpertos.xlsm").Activate
Range("C2").Select
ActiveCell.FormulaR1C1 = "Aquí repites el asunto"
End Sub
Sub ParaTodoExpertos()
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 Msg As String
'
Set OutlookApp = New Outlook.Application
'
'Rango de Correos
'
For Each cell In Range("B2:B3")
'
'Asignamos valor a las variables
'
Asunto = "Saldo vencido"
Destinatario = cell.Offset(0, -1).Value
Correo = cell.Value
'
'Cuerpo del mensaje
'
Msg = "Saludo " & Destinatario & vbNewLine & vbNewLine
Msg = Msg & "Primer línea de texto "
Msg = Msg & "Segunda línea de texto "
Msg = Msg & "Atentamente:" & vbNewLine
Msg = Msg & "Tu firma."
'
Set MItem = OutlookApp.CreateItem(olMailItem)
With MItem
.To = Correo
.Subject = Asunto
.Body = Msg
.Send
'
End With
'
Next
'
Windows("TodoExpertos.xlsm").Activate
Range("C2").Select
ActiveCell.FormulaR1C1 = "Aquí repites el asunto"
MsgBox "Correo enviado"
End Sub
