Crear PDF y guardar en Datos Adjuntos

Necesita una tabla temporal para almacenar los nombres de archivos que retorne la función, una función para obtener el siguiente archivo y una función para adjuntar el archivo. Le preparé este ejemplo.

TABLAS

Esta tabla se actualiza cada vez que se ejecute la función.

FORMULARIO

REPORTE

CÓDIGO DEL EVENTO DESPUES DE ACTUALIZAR DEL CUADRO COMBINADO

Private Sub cboNumero_AfterUpdate()
 On Error GoTo hay_error
      Dim strSgte As String
      Dim strArchivoAdj As String
      strSgte = sigtePDF(CurrentProject.Path, Me.cboNumero.Column(1), "PDF")
      strArchivoAdj = CurrentProject.Path & "\" & strSgte & ".PDF"
       DoCmd.OpenReport "rptInforme", acViewPreview, , "[nroreg] = " & Me.cboNumero.Column(1), acHidden
       DoCmd.OutputTo acOutputReport, "rptInforme", acFormatPDF, strArchivoAdj, False
       DoCmd.Close acReport, "rptInforme"
      Call Adjunta("tblclientes", "archivo", "nroreg", Me.cboNumero.Column(1), strArchivoAdj)
     If Err.Number = 0 Then
       MsgBox "Archivo PDF creado satisfactoriamente", vbInformation, "Le informo"
     End If
hay_error_exit:
   Exit Sub
hay_error:
    MsgBox "Ocurrió el error " & Err.Number & " - " & Err.Description, vbCritical, "Error..."
    Resume hay_error_exit
End Sub

CÓDIGO DE LA FUNCION sigtePDF

Public Function sigtePDF(mpath As String, lnregistro As Long, mextension As String) As String
 'Función obtener el siguiente archivo con base en el número de registro
 'y la extensión
 Dim MiPc, Carpeta, Archivos, archivo
 Dim miext As String
 Dim cant_tem As Long
 CurrentDb.Execute "DELETE FROM tblTemporal"
Set MiPc = CreateObject("Scripting.FileSystemObject")
Set Carpeta = MiPc.GetFolder(mpath)
Set Archivos = Carpeta.Files
For Each archivo In Archivos
       miext = MiPc.GetExtensionName(archivo.Name)
      If miext = mextension And mid(archivo.Name, 1, 4) = lnregistro Then
        CurrentDb.Execute "INSERT INTO tblTemporal(archivo) VALUES('" & mid(archivo.Name, 1, 7) & "')"
      End If
Next
cant_tem = Nz(DMax("[archivo]", "tblTemporal"))
If cant_tem = 0 Then
  sigtePDF = lnregistro & "001" & "." & mextension
Else
  sigtePDF = cant_tem + 1 & "." & mextension
End If
End Function

CÓDIGO DE LA FUNCIÓN ADJUNTA

Public Function Adjunta(strTabla, strCampoAdjunto, strIDcampo As String, i As Long, strArchivo As String)
    Dim cdb As DAO.Database, rstMain As DAO.Recordset, rstAttach As DAO.Recordset2, _
        fldAttach As DAO.Field2
    Set cdb = CurrentDb
    Set rstMain = cdb.OpenRecordset("SELECT " & strCampoAdjunto & " FROM " & strTabla & " where " & strIDcampo & "= " & i, dbOpenDynaset)
    rstMain.Edit
    Set rstAttach = rstMain(strCampoAdjunto).Value
    rstAttach.AddNew
    Set fldAttach = rstAttach.Fields("FileData")
    fldAttach.LoadFromFile strArchivo
    rstAttach.Update
    rstAttach.Close
    Set rstAttach = Nothing
    rstMain.Update
    rstMain.MoveNext
    rstMain.Close
    Set rstMain = Nothing
    Set cdb = Nothing
End Function

EJEMPLO DE ARCHIVOS

Utilicé funciones para poderlas llamar desde cualquier formulario.

Personalmente no utilizo archivos adjuntos, son un desastre. Preparé este ejemplo para dar respuesta a su pregunta, requiere conocimiento avanzado de VBA. Si quiere el ejemplo lo puede solicitar a [email protected] favor anotar la consulta en el asunto.

Si no quiere utilizar tabla temporal y en su lugar un array, puede reemplazar la función sigtePDF() por la siguiente:

Public Function sigtePDF(mpath As String, lnregistro As Long, mextension As String) As String
'Función obtener el siguiente archivo con base en el número de registro
 'y la extensión
'Por ejemplo: Archivos ...
' 1145001.PDF
' 1145002.PDF
' Al llamar la función se
' obtiene el siguiente 1145003.PDF
' En donde 1145 es el código del alumno o el ID
'
'Elaborado por: EDUARDO PÉEZ FERNÁNDEZ
 'Fecha: 24/02/2022
 'Versión 2.0
'Parámetros:
' mpath ----> Ruta donde se guardan los PDF
' lnregistro ----> Código del registro (alumno, empleado etc)
' mextension ----> Extensión del archivo, por ejemplo. "PDF","TXT"
'
'Ejemplo de llamada:
'
 '                  sigtePDF("D:\TodoExpertos\AdjuntarArchivo",1145,"PDF")
 '
 Dim MiPc, Carpeta, Archivos, archivo
 Dim miext As String
'Dim cant_tem As Long 'Decomente esta linea si usa tabla temporal
'**************************************
 'Comente estas linea para usar tabla temporal
 Dim strTem As String
 Dim miArray() As String
'**************************************
' Descomentar para usar tabla temporal
' CurrentDb.Execute "DELETE FROM tblTemporal"
Set MiPc = CreateObject("Scripting.FileSystemObject")
Set Carpeta = MiPc.GetFolder(mpath)
Set Archivos = Carpeta.Files
For Each archivo In Archivos
       miext = MiPc.GetExtensionName(archivo.Name)
      If miext = mextension And mid(archivo.Name, 1, 4) = lnregistro Then
       'Comentar la siguiente para usar tabla
        strTem = strTem & mid(archivo.Name, 1, 7) & ","
        'Descomentar para usar tabla
       ' CurrentDb.Execute "INSERT INTO tblTemporal(archivo) VALUES(" & mid(archivo.Name, 1, 7) & ")"
      End If
Next
'Documente estas lineas si utiliza tabla temporal
'****************************************************
 If strTem <> "" Then  'Retiro la coma (,)
  strTem = Left(strTem, Len(strTem) - 1)
 End If
If Len(strTem) = 0 Then 'Ya habia pdf
  sigtePDF = lnregistro & "001" & "." & mextension
Else
  miArray = Split(strTem, ",")
  sigtePDF = miArray(UBound(miArray)) + 1 & "." & mextension
End If
'*****************************************************
'Descomentar si utiliza la tabla temporal y NO Array
 'cant_tem = Nz(DMax("[archivo]", "tblTemporal")) 'Descomentar para usar tabla temporal
'If cant_tem = 0 Then
 ' sigtePDF = lnregistro & "001" & "." & mextension
'Else
'  sigtePDF = cant_tem + 1 & "." & mextension
'End If
End Function

Es más practica esta otra forma, ya es cuestión de gusto.