Macro para enviar correos desde un archivo Excel

Espero me puedan ayudar, tengo un archivo Excel con el detalle de ventas por sucursal mensual, todos los meses tengo que crear un archivo para cada sucursal y enviar un correo a cada a jefe, creo que esto se podría hacer con una macro, espero alguien me pueda ayudar, desde ya se agradece todo el apoyo.

Respuesta

Yo hace un tiempo puse un post referente a esto y creo que hay alguna cosa más por el foro.

Intenta buscar el post y adecuarlo a lo que necesites.

Has de saber que con el lenguaje VBA solo puedes enviar correos planos (sin negritas, ni subrayados...), para darle formato al texto lo has de hacer con HTML. Aparte tampoco aplica la firma.

Te adjunto mi macro para correo que hay lenguaje VBA y HTML pero la has de entender y adaptar como lo necesites.

Como veras en mi ejemplo le doy formato al texto y soluciono el problema de la firma.

Pude hacer esta macro gracias a la ayuda de muchos de los compañeros de este foro.

En Sub_adjuntar la diferencia que hay es que se te abre el outlook con el mensaje y los archivos adjuntos y puedes adjuntar más archivos y has de pulsar tu el botón de enviar.

En Sub_enviar directamente envía el correo con los datos adjuntos sin abrir outlook y te lo confirma mediante un MSGBOX.

Hay cosas que están en Catalán si crees que te van ayudar a entender el código usa el traductor aunque creo que se puede entender bien.

No soy un experto ni nada por el estilo, no se si la programación es la mejor pero a mi me funciona

Private Sub adjuntar_Click()
        Application.ScreenUpdating = False
        Application.CutCopyMode = False
hoja_1 = "Buscador"
    Set l1 = ThisWorkbook
    Set h1 = l1.Sheets(hoja_1) '
ruta = "z:\DIGITALITZACIONS\Expedients tramitats\signatures\"
logo = "logotip.jpg"
    libro2 = "dades.xlsm"
    hoja_2 = "Registres enviats"
    ruta2 = ThisWorkbook.Path & "\"
Dim OutlookApp As outlook.Application
Dim MItem As outlook.MailItem
Dim Correo As String
Dim adjunt As Variant
Dim registre As String
Dim Msg As String
Const olFormatHTML As Integer = 2
Const ForReading As Integer = 1
Const TristateUseDefault As Integer = -2
If generica.Value = True Then
ElseIf Alicia.Value = True Then
ElseIf Pol.Value = True Then
ElseIf Silvia.Value = True Then
ElseIf jmaria.Value = True Then
ElseIf teresa.Value = True Then
ElseIf anna.Value = True Then
ElseIf lorea.Value = True Then
ElseIf merce.Value = True Then
ElseIf Pere.Value = True Then
 Else
            MsgBox "Selecciona una signatura"
Exit Sub
End If
If generica.Value = True Then
Set MiPc = CreateObject("Scripting.FileSystemObject")
Set Cadena = MiPc.GetFile("z:\DIGITALITZACIONS\Expedients tramitats\signatures\firma generica.htm").OpenAsTextStream(ForReading, TristateUseDefault)
firma = Cadena.ReadAll
ElseIf Alicia.Value = True Then
Set MiPc = CreateObject("Scripting.FileSystemObject")
Set Cadena = MiPc.GetFile("z:\DIGITALITZACIONS\Expedients tramitats\signatures\firma alicia.htm").OpenAsTextStream(ForReading, TristateUseDefault)
firma = Cadena.ReadAll
ElseIf Pol.Value = True Then
Set MiPc = CreateObject("Scripting.FileSystemObject")
Set Cadena = MiPc.GetFile("z:\DIGITALITZACIONS\Expedients tramitats\signatures\firma pol.htm").OpenAsTextStream(ForReading, TristateUseDefault)
firma = Cadena.ReadAll
ElseIf Silvia.Value = True Then
Set MiPc = CreateObject("Scripting.FileSystemObject")
Set Cadena = MiPc.GetFile("z:\DIGITALITZACIONS\Expedients tramitats\signatures\firma silvia.htm").OpenAsTextStream(ForReading, TristateUseDefault)
firma = Cadena.ReadAll
ElseIf jmaria.Value = True Then
Set MiPc = CreateObject("Scripting.FileSystemObject")
Set Cadena = MiPc.GetFile("z:\DIGITALITZACIONS\Expedients tramitats\signatures\firma josep maria.htm").OpenAsTextStream(ForReading, TristateUseDefault)
firma = Cadena.ReadAll
ElseIf teresa.Value = True Then
Set MiPc = CreateObject("Scripting.FileSystemObject")
Set Cadena = MiPc.GetFile("z:\DIGITALITZACIONS\Expedients tramitats\signatures\firma teresa.htm").OpenAsTextStream(ForReading, TristateUseDefault)
firma = Cadena.ReadAll
ElseIf anna.Value = True Then
Set MiPc = CreateObject("Scripting.FileSystemObject")
Set Cadena = MiPc.GetFile("z:\DIGITALITZACIONS\Expedients tramitats\signatures\firma anna.htm").OpenAsTextStream(ForReading, TristateUseDefault)
firma = Cadena.ReadAll
ElseIf lorea.Value = True Then
Set MiPc = CreateObject("Scripting.FileSystemObject")
Set Cadena = MiPc.GetFile("z:\DIGITALITZACIONS\Expedients tramitats\signatures\firma lorea.htm").OpenAsTextStream(ForReading, TristateUseDefault)
firma = Cadena.ReadAll
ElseIf merce.Value = True Then
Set MiPc = CreateObject("Scripting.FileSystemObject")
Set Cadena = MiPc.GetFile("z:\DIGITALITZACIONS\Expedients tramitats\signatures\firma merce.htm").OpenAsTextStream(ForReading, TristateUseDefault)
firma = Cadena.ReadAll
ElseIf Pere.Value = True Then
Set MiPc = CreateObject("Scripting.FileSystemObject")
Set Cadena = MiPc.GetFile("z:\DIGITALITZACIONS\Expedients tramitats\signatures\firma pere.htm").OpenAsTextStream(ForReading, TristateUseDefault)
firma = Cadena.ReadAll
End If
Set OutlookApp = New outlook.Application
        adjunt = "z:\DIGITALITZACIONS\Expedients tramitats\Registres tramitats a les oficines" & "\" & h1.registre_oficina.Value & "\" & h1.registre_oficina.Value & "-" & h1.registre_numero.Value & "-" & h1.registre_any.Value & "\" & h1.registre_oficina.Value & "-" & h1.registre_numero.Value & "-" & h1.registre_any.Value & " RR.pdf"
        registre = h1.registre_oficina.Value & "/" & h1.registre_numero.Value & "/" & h1.registre_any.Value
        'Cuerpo del mensaje
        '
        Cuerpo = "Benvolgut/da, " & _
        "<p>Adjunt us fem arribar el comprovant d'enviament a través de la plataforma EACAT, de l'expedient amb número<b> " & registre & "</b>.</p>
" & _
        "<p>Podeu facilitar aquest resguard a la persona interessada si així us ho demanen.</p>
" & _
        "<p>Salutacions,</p>
" & _
        "<br> <br> <br>"
        Set MItem = OutlookApp.CreateItem(olMailItem)
        Set b = h1.Columns("N").Find(h1.registre_oficina.Value, LookIn:=xlValues, lookat:=xlWhole)
    If Not b Is Nothing Then
        With MItem
            .To = h1.Cells(b.Row, "P")
            .Subject = "Rebut del registre " & registre & " mitjançant EACAT"
            .Attachments.Add (adjunt)
            .Attachments.Add ruta & logo
            .BodyFormat = olFormatHTML
            .HTMLBody = _
                "<HTML> " & _
                    "<BODY>" & _
                        Cuerpo & _
                        "<img src=cid:" & logo & " height=35 width=172>" & _
                    firma & _
                    "</BODY> " & _
                "</HTML>"
            '
          .Display
        End With
   Dim Carpeta As String
hoja_1 = "Buscador"
    Set l1 = ThisWorkbook
    Set h1 = l1.Sheets("buscador")
   Carpeta = "z:\DIGITALITZACIONS\Expedients tramitats\Registres tramitats a les oficines" & "\" & h1.registre_oficina.Value & "\" & h1.registre_oficina.Value & "-" & h1.registre_numero.Value & "-" & h1.registre_any.Value
     Call Shell("explorer.exe " & Carpeta, vbNormalFocus)
    End If
   correu2.Hide
End Sub
Private Sub enviar_Click()
        Application.ScreenUpdating = False
hoja_1 = "Buscador"
    Set l1 = ThisWorkbook
    Set h1 = l1.Sheets(hoja_1) '
ruta = "z:\DIGITALITZACIONS\Expedients tramitats\signatures\"
logo = "logotip.jpg"
    libro2 = "dades.xlsm"
    hoja_2 = "Registres enviats"
    ruta2 = ThisWorkbook.Path & "\"
Dim OutlookApp As outlook.Application
Dim MItem As outlook.MailItem
Dim Correo As String
Dim adjunt As Variant
Dim registre As String
Dim Msg As String
Const olFormatHTML As Integer = 2
Const ForReading As Integer = 1
Const TristateUseDefault As Integer = -2
If generica.Value = True Then
ElseIf Alicia.Value = True Then
ElseIf Pol.Value = True Then
ElseIf Silvia.Value = True Then
ElseIf jmaria.Value = True Then
ElseIf teresa.Value = True Then
ElseIf anna.Value = True Then
ElseIf lorea.Value = True Then
ElseIf merce.Value = True Then
ElseIf Pere.Value = True Then
Else
            MsgBox "Selecciona una signatura"
Exit Sub
End If
If generica.Value = True Then
Set MiPc = CreateObject("Scripting.FileSystemObject")
Set Cadena = MiPc.GetFile("z:\DIGITALITZACIONS\Expedients tramitats\signatures\firma generica.htm").OpenAsTextStream(ForReading, TristateUseDefault)
firma = Cadena.ReadAll
ElseIf Alicia.Value = True Then
Set MiPc = CreateObject("Scripting.FileSystemObject")
Set Cadena = MiPc.GetFile("z:\DIGITALITZACIONS\Expedients tramitats\signatures\firma alicia.htm").OpenAsTextStream(ForReading, TristateUseDefault)
firma = Cadena.ReadAll
ElseIf Pol.Value = True Then
Set MiPc = CreateObject("Scripting.FileSystemObject")
Set Cadena = MiPc.GetFile("z:\DIGITALITZACIONS\Expedients tramitats\signatures\firma pol.htm").OpenAsTextStream(ForReading, TristateUseDefault)
firma = Cadena.ReadAll
ElseIf Silvia.Value = True Then
Set MiPc = CreateObject("Scripting.FileSystemObject")
Set Cadena = MiPc.GetFile("z:\DIGITALITZACIONS\Expedients tramitats\signatures\firma silvia.htm").OpenAsTextStream(ForReading, TristateUseDefault)
firma = Cadena.ReadAll
ElseIf jmaria.Value = True Then
Set MiPc = CreateObject("Scripting.FileSystemObject")
Set Cadena = MiPc.GetFile("z:\DIGITALITZACIONS\Expedients tramitats\signatures\firma josep maria.htm").OpenAsTextStream(ForReading, TristateUseDefault)
firma = Cadena.ReadAll
ElseIf teresa.Value = True Then
Set MiPc = CreateObject("Scripting.FileSystemObject")
Set Cadena = MiPc.GetFile("z:\DIGITALITZACIONS\Expedients tramitats\signatures\firma teresa.htm").OpenAsTextStream(ForReading, TristateUseDefault)
firma = Cadena.ReadAll
ElseIf anna.Value = True Then
Set MiPc = CreateObject("Scripting.FileSystemObject")
Set Cadena = MiPc.GetFile("z:\DIGITALITZACIONS\Expedients tramitats\signatures\firma anna.htm").OpenAsTextStream(ForReading, TristateUseDefault)
firma = Cadena.ReadAll
ElseIf lorea.Value = True Then
Set MiPc = CreateObject("Scripting.FileSystemObject")
Set Cadena = MiPc.GetFile("z:\DIGITALITZACIONS\Expedients tramitats\signatures\firma lorea.htm").OpenAsTextStream(ForReading, TristateUseDefault)
firma = Cadena.ReadAll
ElseIf merce.Value = True Then
Set MiPc = CreateObject("Scripting.FileSystemObject")
Set Cadena = MiPc.GetFile("z:\DIGITALITZACIONS\Expedients tramitats\signatures\firma merce.htm").OpenAsTextStream(ForReading, TristateUseDefault)
firma = Cadena.ReadAll
ElseIf Pere.Value = True Then
Set MiPc = CreateObject("Scripting.FileSystemObject")
Set Cadena = MiPc.GetFile("z:\DIGITALITZACIONS\Expedients tramitats\signatures\firma pere.htm").OpenAsTextStream(ForReading, TristateUseDefault)
firma = Cadena.ReadAll
End If
Set OutlookApp = New outlook.Application
        adjunt = "z:\DIGITALITZACIONS\Expedients tramitats\Registres tramitats a les oficines" & "\" & h1.registre_oficina.Value & "\" & h1.registre_oficina.Value & "-" & h1.registre_numero.Value & "-" & h1.registre_any.Value & "\" & h1.registre_oficina.Value & "-" & h1.registre_numero.Value & "-" & h1.registre_any.Value & " RR.pdf"
        registre = h1.registre_oficina.Value & "/" & h1.registre_numero.Value & "/" & h1.registre_any.Value
        'Cuerpo del mensaje
        '
        Cuerpo = "Benvolgut/da, " & _
        "<p>Adjunt us fem arribar el comprovant d'enviament a través de la plataforma EACAT, de l'expedient amb número<b> " & registre & "</b>.</p>
" & _
        "<p>Podeu facilitar aquest resguard a la persona interessada si així us ho demanen.</p>
" & _
        "<p>Salutacions,</p>
" & _
        "<br> <br> <br>"
        Set MItem = OutlookApp.CreateItem(olMailItem)
        Set b = h1.Columns("N").Find(h1.registre_oficina.Value, LookIn:=xlValues, lookat:=xlWhole)
    If Not b Is Nothing Then
        With MItem
            .To = h1.Cells(b.Row, "P")
            .Subject = "Rebut del registre " & registre & " mitjançant EACAT"
            .Attachments.Add (adjunt)
            .Attachments.Add ruta & logo
            .BodyFormat = olFormatHTML
            .HTMLBody = _
                "<HTML> " & _
                    "<BODY>" & _
                        Cuerpo & _
                        "<img src=cid:" & logo & " height=35 width=172>" & _
                    firma & _
                    "</BODY> " & _
                "</HTML>"
            '
          .Send
        End With
    End If
    CreateObject("wscript.shell").Popup _
    "El correu ha estat enviat correctament ", 1, "Missatge temporal"
Correu2. Hide
End Sub

Para que entiendas algo más la macro te enseño el form. Primeo has de seleccionar la persona que firma el correo y luego pulsar uno de los 2 botones

1 respuesta más de otro experto

Respuesta

[Hola

Si usas Microsoft Outlook, comienza por dar una mirada por aquí:

https://abrahamexcel.blogspot.com/2018/02/microsoft-outlook-desde-excel-vba.html 

Si tu intención es usar un correo pero no desd Otulook, mira aquí:

http://www.rondebruin.nl/win/s1/cdo.htm 

Saludos]

Abraham Valencia

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas

¿Cómo separo dos números que se encuentran en una sola celda de excel?

En una celda de excel se encuentran dos cantidades separadas por un guion. Quisiera separar el primer número en una segunda celda y el segundo número en una tercer celda. Ejemplo: A 1 48,264 - 65,371 2 55,555 - 66,666 3 . . . Debería quedar así: A B...
2 respuestas

Al seleccionar celda extraer sus dígitos automáticamente

Necesito dos favores, la idea es que al seleccionar una celda numérica de 4 dígitos del rango "af1;aj42" esta automáticamente extraiga sus cifras a la columna "a1, b1, c1, d1" como se muestra en la imagen Y lo segundo como puedo quitarle el msgbox a...
2 respuestas

Se puede agregar voz a Excel

Tengo una pantalla de vuelo de vuelo donde anotó despegues y arribos, Quiero que cada vez que se produzca un despegue y se agregue hora o aterrice alguno y se ponga la hora, excel diga o se escuche atención Aterrizaje o Atención despegue.
3 respuestas

Gráfico Comparativo por Semanas, en Power Bi.

Espero se encuentren muy bien. Tengo una tabla en Power BI con fechas, códigos, costos y cantidades. La necesidad que tengo es de crear un gráfico o tabla donde pueda comparar y analizar el comportamiento de los costos y las cantidades de un código...
1 respuesta

En una lista para pedidos tengo varios formularios

En una lista para pedidos con varios formularios la vengo usando desde hace tiempo sin ningún problema pero hace días la abrí para hacer un pedido y al pisar en el cuadro donde apunta la flecha para que me abra un otro cuadro donde coloco ciertos...
2 respuestas

Código VBA para crear un botón y guardar en PDF

Tengo un archivo word con 7 capturas, una en cada página (1-7), cual seria el código para crear un botón en la barra de herramientas de acceso rápido para convertir en PDF cada página. El resultado seria 7 pdf.
2 respuestas

Detectar si he marcado Celda dentro de un Rango de Excel.

Tengo un Rango en Hoja Excel: RgoDatos >> $B$3:$V$39 Quiero detectar si la celda que selecciono está dentro de ese Rango Si no está que por omisión me marque B3.
1 respuesta

Dato fecha ya existe en tabla

Como están estimados maestros. En formulario, tengo botón archivar. Envío información a hoja "existencias" a tabla "tbl_existencias". En columna A un Código desde textbox1 En columna B fecha desde textbox "txtFecha2" En columna C total desde textbox2...
2 respuestas

Enviar hoja activa al monitor secundario con vba

He creado una segunda ventana de mi hoja excel con NewWindow, y lo que pretendo es mediante código VBA enviarla al monitor secundario, lo he intentado con Application.SendKeys "^({ESC}+{RIGHT})", pero no lo consigo, con "^{ESC}" estoy tratando de...
2 respuestas

Ingresar información en una hoja y rescatar los datos principales en otra hoja ordenadamente.

Debo hacer cotizaciones y necesito guardar la información de los datos de las personas en una BD, sin ocupar Tablas. Lo principal de esto es que queden ordenada según el número de la cotización y mantener el número correlativo de la cantidad de...
1 respuesta