Visual Basic para Aplicaciones - adjuntar varios ficheros a email

Life is soft - evento anual de software empresarial

Pos: 47

Val: 15

adjuntar varios ficheros a email

Publicado por juan francisco (10 intervenciones) el 12/10/2016 09:25:47

Hola!!!

tengo una carpeta con varios PDF generados automáticamente en excel vba, quiero saber como adjuntar varios ficheros pdf a un email según el nombre de una celda. Alguien me puede ayudar?

gracias.

Valora esta pregunta

Me gusta: Está pregunta es útil y esta clara

No me gusta: Está pregunta no esta clara o no es útil

Responder

Pos: 26

Val: 28

adjuntar varios ficheros a email

Publicado por Andres Leonardo (26 intervenciones) el 01/11/2016 16:38:05

te pregunto y desde bva vas a aneviar el correo???

Valora esta respuesta

Me gusta: Está respuesta es útil y esta clara

No me gusta: Está respuesta no esta clara o no es útil

Comentar

adjuntar varios ficheros a email

Publicado por Oscar Rubió (19 intervenciones) el 08/11/2016 12:20:00

Lo que pides no es complicado, pero necesitaría saber cómo relacionas los archivos a adjuntar con el nombre de la celda, es decir, ¿nombras los pdf de una forma en concreto para que con el nombre de la celda sepas cuáles has de adjuntar, o son todos los pdf los que debes adjuntar?

Valora esta respuesta

Comentar

adjuntar varios ficheros a email

Publicado por Oscar Rubió (19 intervenciones) el 08/11/2016 12:45:01

Te paso el script (debes colocarlo en un módulo) para el caso de tener que adjuntar todos los archivos de la carpeta donde guardas los pdf:

Dim OutApp As Object

Dim OutMail As Object

Set OutApp = CreateObject("Outlook.Application")

Set OutMail = OutApp.CreateItem(0)

On Error Resume Next

 carpeta = “ruta completa de tu carpeta donde están los pdf”

If Right(carpeta, 1) <> "\" Then

    carpeta = carpeta & "\"

End If

With OutMail

    .Display

    .To = “destinatario@destinatario.com”

    .Subject = "Asunto”

     contador = 1

     archivos = Dir(carpeta)

     Do While Len(archivos) > 0

        .Attachments.Add(carpeta & archivos)

	    archivos = Dir()

	    contador = contador + 1

   Loop

End With

Set OutMail = Nothing

Set OutApp = Nothing

Valora esta respuesta

Comentar

Pos: 47

Val: 15

adjuntar varios ficheros a email

Publicado por juan francisco (10 intervenciones) el 08/11/2016 20:17:55

Por ejemplo cuando genera los fichero PDF de caja hoja, me crea una hoja, en la cual en la columna A está la dirección email del destinatario, COLUMNA B nombre del dpto, COLUMNA C el nombre del trabajador Y COLUMNA D la ruta del archivo y el nombre del PDF generado

Valora esta respuesta

Comentar

adjuntar varios ficheros a email

Publicado por Oscar Rubió (19 intervenciones) el 09/11/2016 08:37:56

Dim OutApp As Object

Dim OutMail As Object

Set OutApp = CreateObject("Outlook.Application")

Set OutMail = OutApp.CreateItem(0)

On Error Resume Next

carpeta = “ruta completa de tu carpeta donde están los pdf”

If Right(carpeta, 1) <> "\" Then

    carpeta = carpeta & "\"

End If

 For i=1 to Cells("c1").End(xldown).Row

      If cells(i,3)= aquí debes poner la condición que debe cumplirse en la columna 3, o sea la C Then

          With OutMail

             .Display

             .To = cells(i,1)

             .Subject = cells(i,3)

             contador = 1

             archivos = Dir(carpeta)

             Do While Len(archivos) > 0

               .Attachments.Add(carpeta & archivos)

	       archivos = Dir()

	       contador = contador + 1

            Loop

        End With

    End If

  Next i

Set OutMail = Nothing

Set OutApp = Nothing

Con este script recorrerás toda la columna C (recuerda que no pueden haber celdas vacías intermedias) y creará el mail deseado.

Valora esta respuesta

Comentar

Pos: 47

Val: 15

adjuntar varios ficheros a email

Publicado por juan francisco (10 intervenciones) el 09/11/2016 21:32:10

Buenas!!
muchas gracias lo probaré, pero antes tengo que solucionar un problema con este código: no me funciona del todo bien, me crea la hora y obtiene los valores de cada hoja y los pega en cada columna como dije en comentarios anteriores.

CrearHoja "EMAIL"

ActiveSheet.Name = "EMAIL"

For x = 1 To Sheets.Count

    Sheets(x).Select

    dpto = Trim(Sheets(x).Range("N9"))

    nombreempleado = Trim(Sheets(x).Range("N10"))

    nombrefichero = dpto & Chr(95) & nombreempleado

    celda = Sheets(x).Range("ZZ100")

    ruta1 = ruta & Chr(92) & Sheets("INDICE").Range("AÑO") & Chr(92) & mes & Sheets("INDICE").Range("J4") & Chr(92) & "DETALLE HORAS" & Chr(92) & Sheets(x).Range("AC6") & " DETALLE HORAS " & Sheets("INDICE").Range("J4") & Chr(95) & nombrefichero & ".pdf"

    If celda = "F" Then

        Sheets(x).Range("n9").Copy

        Sheets("EMAIL").Range("B65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues

        Sheets(x).Range("n10").Copy

        Sheets("EMAIL").Range("C65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues

        Sheets("EMAIL").Range("D65000").End(xlUp).Offset(1, 0).Value = ruta1

    End If

Next

Valora esta respuesta

Comentar

adjuntar varios ficheros a email

Publicado por Oscar Rubió (19 intervenciones) el 10/11/2016 08:33:55

Por un lado veo dos variables sin valor: ruta y mes

Por otro, creo que deberías condicionar el bucle para que no tuviera en cuenta la hoja EMAIL, que es la que acabas de crear:

CrearHoja "EMAIL"

ActiveSheet.Name = "EMAIL"

For x = 1 To Sheets.Count

  If Not Sheets(x).Name="EMAIL" Then

    Sheets(x).Select

    dpto = Trim(Sheets(x).Range("N9"))

    nombreempleado = Trim(Sheets(x).Range("N10"))

    nombrefichero = dpto & Chr(95) & nombreempleado

    celda = Sheets(x).Range("ZZ100")

    ruta1 = ruta & Chr(92) & Sheets("INDICE").Range("AÑO") & Chr(92) & mes & Sheets("INDICE").Range("J4") & Chr(92) & "DETALLE HORAS" & Chr(92) & Sheets(x).Range("AC6") & " DETALLE HORAS " & Sheets("INDICE").Range("J4") & Chr(95) & nombrefichero & ".pdf"

    If celda = "F" Then

        Sheets(x).Range("n9").Copy

        Sheets("EMAIL").Range("B65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues

        Sheets(x).Range("n10").Copy

        Sheets("EMAIL").Range("C65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues

        Sheets("EMAIL").Range("D65000").End(xlUp).Offset(1, 0).Value = ruta1

    End If

  End If

Next

Valora esta respuesta

Comentar

Pos: 47

Val: 15

adjuntar varios ficheros a email

Publicado por juan francisco (10 intervenciones) el 10/11/2016 18:50:14

Buenas !!!

Las variables están declaradas, lo que me refería era de optimizar el código o está correcto??, funciona bien pero quería mejorar el código

Atentamente, un saludo

Valora esta respuesta

Comentar

Numerar paginas en word

VBA Access: Establecer valores en 2 columnas en un combobox