Excel - Correo con CommandButton

 
Vista:
sin imagen de perfil

Correo con CommandButton

Publicado por Patricio (29 intervenciones) el 29/11/2010 20:18:48
hola, buenas tardes, necesito si alguien me puede ayudar con la creacion de un commanbuttin para enviar un correo desde una hoja excel.

Tengo el siguiente codigo, pero quiero agregar copia para dos destinatarios y agregar texto en el cuerpo del mensaje de outlook.

Private Sub CommandButton1_Click()
Select Case Application.MailSystem
Case xlMAPI
ThisWorkbook.SendMail Recipients:="[email protected]"

Case xlNoMailSystem
MsgBox "Conteo"

Case Else
End Select

End Sub

agradeceria la ayuda.
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder
Imágen de perfil de Gonzalo
Val: 13
Ha disminuido su posición en 50 puestos en Excel (en relación al último mes)
Gráfica de Excel

RE:Correo con CommandButton

Publicado por Gonzalo (73 intervenciones) el 06/12/2010 17:44:57
Patricio:
Te paso un código que a mi me funciona bastante bien. Es para trabajr con Outlook.
Fijate y cualquier cosa, avisame. Te dejo mi mail: [email protected]
Lo único que tienes que hacer es agregar un botón en la hoja de Excel que quieras y asignarle la "Macro_Inicio".

Espero te sirva. Saludos,

Gonzalo

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

'PASO 0: No muestra las alertas
Application.DisplayAlerts = False

'PASO 1: POSICIONARME EN EL 1ER. LEGAJO
Range("A2").Select

'PASO 2: Mientras tenga algun legajo escrito que le envie email
While ActiveCell.Offset(0, 0).Value <> ""

'PASO 2.2: Guardo el nro de legajo
NOMBRE_LEGAJO = ActiveCell.Offset(0, 0).Value
EMAIL_LEGAJO = ActiveCell.Offset(0, 1).Value

'PASO 2.3: Me muevo a otro archivo

'GRABAR COMO DRAFT EN EMAIL OUTLOOK
CUERPO_MENSAJE = "Buenos días" & Chr(13) & _
"Le hago llegar el informe... " & Chr(13) & _
"Muchas gracias"
TITULO_MENSAJE = "Informe Mensual " & NOMBRE_LEGAJO
ADJUNTO_MENSAJE = "C:\Documents and Settings\gquintana\Escritorio\Excel y Macros.pdf"
Call Enviar_Email_Outlook(EMAIL_LEGAJO, TITULO_MENSAJE, CUERPO_MENSAJE, ADJUNTO_MENSAJE)

'PASO 2.4: Me muevo al siguiente legajo
ActiveCell.Offset(1, 0).Select
Wend

'PASO 3: 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_ADJUNTOmanager para agregar cada uno de los archivos excel
.Attachments.Add EMAIL_ADJUNTO
.Save 'Lo graba como draft (sino usar .Send para enviar el email directamente)
End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar