Enviar un email personalizando el cuerpo del email
Hola:
Estoy haciendo una macro para que me envíe un documento excel a una serie de personas y lo que quiero es que me de la opción de personalizar el cuerpo del mensaje (no el asunto).
Tal como lo tengo ahora mismo pulsas un botón y primero te pide una clave (para que no todo el mundo pueda enviar el documento) y si la metes correctamente se envía. Lo que quería es que, antes de enviarlo, te salga una especie de InputBox o lo que hiciera falta, donde pongas tus comentarios sobre el email. El asunto lo quiero fijo porque el tema siempre será el mismo pero quiero poder variar los comentarios sobre documento como "hoy el número de células ha subido...", "hoy el número de células se mantiene estable...".
Te adjunto el código que tengo escrito hasta ahora.
Sub SEND EMAIL()
'Crear un mensaje de alerta pidiendo una contraseña
Entrada = InputBox("Password Please", "Restricted Accessssss")
If Entrada = "123456789" Then
'macro para restringir con clave.
Dim Emails(1) As String 'e-mail addresses to be sent to
Emails(0) = [email protected]
Emails(1) = [email protected]
ActiveWorkbook.SendMail Recipients:=Emails, Subject:="Experiment"
'Fin del macro para mandar un email
Else
MsgBox "Access Denied", vbExclamation, "Wrong password"
End If
End Sub
Un saludo, y gracias de antemano.
Estoy haciendo una macro para que me envíe un documento excel a una serie de personas y lo que quiero es que me de la opción de personalizar el cuerpo del mensaje (no el asunto).
Tal como lo tengo ahora mismo pulsas un botón y primero te pide una clave (para que no todo el mundo pueda enviar el documento) y si la metes correctamente se envía. Lo que quería es que, antes de enviarlo, te salga una especie de InputBox o lo que hiciera falta, donde pongas tus comentarios sobre el email. El asunto lo quiero fijo porque el tema siempre será el mismo pero quiero poder variar los comentarios sobre documento como "hoy el número de células ha subido...", "hoy el número de células se mantiene estable...".
Te adjunto el código que tengo escrito hasta ahora.
Sub SEND EMAIL()
'Crear un mensaje de alerta pidiendo una contraseña
Entrada = InputBox("Password Please", "Restricted Accessssss")
If Entrada = "123456789" Then
'macro para restringir con clave.
Dim Emails(1) As String 'e-mail addresses to be sent to
Emails(0) = [email protected]
Emails(1) = [email protected]
ActiveWorkbook.SendMail Recipients:=Emails, Subject:="Experiment"
'Fin del macro para mandar un email
Else
MsgBox "Access Denied", vbExclamation, "Wrong password"
End If
End Sub
Un saludo, y gracias de antemano.
2 respuestas
Respuesta de prozac
-1
Te envio una solución basada en una macro de otra persona, pero adaptada a lo que ya tienes. El texto del body lo tendrás que cambiar a tu gusto. Puedes abrir una ventana de mensaje y añadirlo igual que haces con la password, si lo prefires.
También puedes obviar .Display si no quires que te enseñe el mensaje antes del envio.
Sub EnviaEmail()
'Macro basada en una de Tom Urtis
Dim Entrada As String
Dim Emails(1) As String 'e-mail addresses to be sent to
Dim myOutlook As Object
Dim myMailItem As Object
Entrada = InputBox("Password Please", "Restricted Accessssss")
If Entrada = "123456789" Then
Emails(0) = "[email protected]"
Emails(1) = "[email protected]"
Set otlApp = CreateObject("Outlook.Application")
Set otlNewMail = otlApp.CreateItem(olMailItem)
fName = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name
With otlNewMail
.To = Emails(0) & ";" & Emails(1)
.CC = "[email protected]"
.Subject = "Experiment"
.Body = "Esto es mi comentario." & Chr(13) & "Saludos," & Chr(13) & "Calroa" & Chr(13) & Chr(13)
.Attachments.Add fName
.Display
.SEND
End With
otlApp.Quit
Set otlNewMail = Nothing
Set otlApp = Nothing
Set otlAttach = Nothing
End If
End Sub
También puedes obviar .Display si no quires que te enseñe el mensaje antes del envio.
Sub EnviaEmail()
'Macro basada en una de Tom Urtis
Dim Entrada As String
Dim Emails(1) As String 'e-mail addresses to be sent to
Dim myOutlook As Object
Dim myMailItem As Object
Entrada = InputBox("Password Please", "Restricted Accessssss")
If Entrada = "123456789" Then
Emails(0) = "[email protected]"
Emails(1) = "[email protected]"
Set otlApp = CreateObject("Outlook.Application")
Set otlNewMail = otlApp.CreateItem(olMailItem)
fName = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name
With otlNewMail
.To = Emails(0) & ";" & Emails(1)
.CC = "[email protected]"
.Subject = "Experiment"
.Body = "Esto es mi comentario." & Chr(13) & "Saludos," & Chr(13) & "Calroa" & Chr(13) & Chr(13)
.Attachments.Add fName
.Display
.SEND
End With
otlApp.Quit
Set otlNewMail = Nothing
Set otlApp = Nothing
Set otlAttach = Nothing
End If
End Sub
Respuesta de Enrique Bernal
-1
Esto debería hacer lo que necesitas, prueba y me avisas.
Sub SEND_EMAIL()
'Crear un mensaje de alerta pidiendo una contraseña
Entrada = InputBox("Password Please", "Restricted Accessssss")
If Entrada = "123456789" Then
a = InputBox("Please, enter your text")
Set objOutlook = CreateObject("Outlook.Application")
Set objNameSpace = objOutlook.GetNameSpace("MAPI")
Set objMailItem = objOutlook.CreateItem(0)
objMailItem.Subject = "Asunto "
objMailItem.Body = "Texto"
objMailItem.SEND
'macro para restringir con clave.
Dim Emails(1) As String 'e-mail addresses to be sent to
'Emails(0) = [email protected]
'Emails(1) = [email protected]
ActiveWorkbook.SendMail Recipients:=Emails, Subject:="Experiment"
'Fin del macro para mandar un email
Else
MsgBox "Access Denied", vbExclamation, "Wrong password"
End If
End Sub
Sub SEND_EMAIL()
'Crear un mensaje de alerta pidiendo una contraseña
Entrada = InputBox("Password Please", "Restricted Accessssss")
If Entrada = "123456789" Then
a = InputBox("Please, enter your text")
Set objOutlook = CreateObject("Outlook.Application")
Set objNameSpace = objOutlook.GetNameSpace("MAPI")
Set objMailItem = objOutlook.CreateItem(0)
objMailItem.Subject = "Asunto "
objMailItem.Body = "Texto"
objMailItem.SEND
'macro para restringir con clave.
Dim Emails(1) As String 'e-mail addresses to be sent to
'Emails(0) = [email protected]
'Emails(1) = [email protected]
ActiveWorkbook.SendMail Recipients:=Emails, Subject:="Experiment"
'Fin del macro para mandar un email
Else
MsgBox "Access Denied", vbExclamation, "Wrong password"
End If
End Sub