Enviar correo electrónico con varios adjuntos
Necesito enviar un correo electrónico desde un formulario "Aceptacion" de todos los adjuntos (pdf), cuyo nombre aparecen relacionado en el campo Albarán del subformulario "Detalleaceptacion" y que a su vez tengo guardado en una carpeta llamada Nº_Albaran. Puede ser uno o mas
Actualmente envío un informe en pdf del registro actual desde el botón email, cuyo código es:
Me. Refresh
If Nz(Me.N_aceptacion, "") = "" Then Exit Sub
If IsNull(Me.mail) Or Me.mail = "" Then
MsgBox "HAGA DOBLE CLICK EN PROVEEDOR PARA AÑADIR EMAIL", vbOKOnly + vbInformation, "AVISO"
Exit Sub
Else
Dim Pregunta As Integer
Dim Fecha_envio
Pregunta = MsgBox("¿SEGURO QUE QUIERES ENVIAR EMAIL?", vbOKOnly + vbInformation, "AVISO")
If Pregunta = 2 Then
Exit Sub
End If
Me.Enviado = True
Me.Fecha_envio = Date
Me.Hora_envio = Format(Now, "hh.mm.ss")
DoCmd.OpenReport "Aceptacion", acViewPreview, , "N_aceptacion='" & Me.N_aceptacion & "'"
DoCmd.SendObject acSendReport, Aceptacion, "PDFFormat(*.pdf)", "" & [mail] & "", "", "", "Aceptacion " & Me.N_aceptacion & "", "Buenas." + vbCrLf + "" + vbCrLf + "Le envío aceptación " & Me.N_aceptacion & " para su tramitación." + vbCrLf + "" + vbCrLf + "" + vbCrLf + "" + vbCrLf + "" + vbCrLf + "" + vbCrLf + "" + vbCrLf + "" + "" & Forms![Panel principal]!Nombre & "" + vbCrLf + "" & Forms![Panel principal]!Destino & "" + vbCrLf + "" & Forms![Panel principal]!correo & "" + vbCrLf + "" + vbCrLf + "" & Forms![Panel principal]!Domicilio & "" + vbCrLf + "" & Forms![Panel principal]!Telefono & "" + vbCrLf + "" + vbCrLf + "" & Forms![Panel principal]!Nota & ""
End If
Como puedo en el mismo código enviar el registro actual en pdf, que ya lo hago, y añadir todos los pdf de los albaranes que tenga relacionado en el campo Albarán del Subformulario y que tengo quardado en la carpeta Nº_Albarán.
1 Respuesta
Acá le dejo la parte principal, trate de adaptarlo a sus necesidades y no olvide cambiar la ruta de la variable strDirectorio por la carpeta donde tiene sus PDF.
Sub EnviaEmailAdjuntosPDF() Dim OutlookApp As Object Dim OutlookMail As Object Dim strEmail As String Dim strAsunto As String Dim strCuerpo As String Dim strAdjunto As String Dim objFolder As Object Dim objFile As Object Dim strDirectorio As String ' Configura los datos del correo electrónico strEmail = "[email protected]" strAsunto = "Adjuntos PDF" strCuerpo = "Adjunto algunos archivos PDF." ' Ruta de la carpeta donde se encuentran los archivos PDF strDirectorio = "C:\Ruta\Archivos\PDF\" ' Crea una instancia de Outlook Set OutlookApp = CreateObject("Outlook.Application") Set OutlookMail = OutlookApp.CreateItem(0) ' Configura el destinatario, asunto y cuerpo del correo With OutlookMail .To = strEmail .Subject = strAsunto .Body = strCuerpo ' Itera a través de los archivos PDF en la carpeta y adjúntalos al correo Set objFolder = CreateObject("Scripting.FileSystemObject").GetFolder(strDirectorio) For Each objFile In objFolder.Files If LCase(Right(objFile.Name, 4)) = ".pdf" Then ' Solo adjunta archivos con extensión .pdf .Attachments.Add objFile.Path End If Next objFile ' Envía el correo electrónico .Send End With ' Libera los objetos Set OutlookMail = Nothing Set OutlookApp = Nothing MsgBox "El correo electrónico se ha enviado con éxito.", vbInformation End Sub
Cambie igualmente este parte del código
strEmail = "[email protected]" strAsunto = "Adjuntos PDF" strCuerpo = "Adjunto algunos archivos PDF."
¡Gracias!
El código funciona y me envía el grupo de pdf, lo que no se es como adjuntar en el mismo correo el informe pdf adjunto que enviaba inicialmente con el código inicial.
Gracias
