Macro Excel Redactar correo con archivo adjunto

Estoy haciendo una encuesta de satisfacción que voy a enviar a clientes para que la rellenen.

Luego darán a un botón de manera que se redacte/envie el mail.

Ahora mismo estoy usando la siguiente:

Sub EnvoiMail()

  Workbooks("Encuesta").SendMail Recipients:="[email protected]", _

                          Subject:="Encuesta de satisfacción", _

                          ReturnReceipt:=True

End Sub

Los problemas que tengo con esta encuesta son:

1. Si el cliente cambia el nombre del archivo, me dejará de funcionar la macro.

2. Me gustaría que los clientes pudieran añadir sus correos en una celda y que cuando se mande el correo, ponga en copia a más gente.

3. He encontrado otra macro en http://www.rondebruin.nl/win/s1/outlook/amail5.htm, peroel problema es que esta macro coge el archivo de una determinada ubicación, pero no puedo saber donde el usuario guardará la tabla.

Lo ideal sería una macro que redactara un correo con un destinatario, copias (las de una celda determinada o rango de celda), asunto, cuerpo, y archivo adjunto. Pero que no se mande de forma automática, de manera que el usuario pueda añadir alguna cosa en el cuerpo del mail.

1 Respuesta

Respuesta
1

Te servirá algo en que los valores que mencionas están en celdas y que, además, permita que el usuario elija el archivo.

Sub EjemploCorreo()
Dim Archivo As String
Dim Outlookapp As New Outlook.Application
Dim MItem As MailItem
With Application.FileDialog(msoFileDialogFilePicker)
        .Filters.Add "Archivos de Excel", "*.xls;*.xlsx"
        .FilterIndex = 2
        .InitialFileName = ThisWorkbook.Path
        .AllowMultiSelect = False
        .Title = "Elija el archivo"
        If .Show = -1 Then
        Let Archivo = .SelectedItems.Item(1)
        Else
        MsgBox "Debes seleccionar el archivo"
        Exit Sub
        End If
End With
Set Outlookapp = New Outlook.Application
Set MItem = Outlookapp.CreateItem(olMailItem)
With MItem
.To = Range("A1")
.CC = Range("A2")
.Subject = Range("A3")
.Body = Range("A4")
.Attachments.Add Archivo
.Send
End With
Set Outlookapp = Nothing
Set MItem = Nothing
End Sub

Eso sí, no olvides que solo servirá para aquellos que tienen configurado Microsoft Outlook y que los correos en las celdas deben estar correctamente llenados (o puedes colocar "controles" de error)

Comentas

Abraham Valencia

Muchas gracias por tu ayuda!

Una cosa, me sale el siguiente mensaje de error, tengo que hacer alguna modificación?

En las referencias de VBA, activa "Microsoft Outlook xx.x Library Objects", en donde "xx.x" es el equivalente al número de tu versión de Office.

Abraham Valencia

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas