Exportar a pdf de forma individual mediante vba
Buenas tardes
tengo una base la cual genera documentos en pdf a través de un formulario y una macro en VB, los genera de dos formas una por todos los registros de una tabla y la otra de forma individual siempre y cuando tengan una marca. He querido hacer modificaciones al vb para integrar una tercera opción en la cual genere de forma individual el documento ingresando un identificador, pero como no soy programado he tratado de entender el código y traspasarlo a mis necesidades, pero no me funciona, espero me puedan ayudar.
tengo 3 tablas, la primera "TblCartas" la cual tiene todos los registros, "TblCartas02" y "TblCartas03" las cuales tiene los registros con la información individual, ya que tengo 2 formularios uno para la tabla 03 y otro para la 02 ya que es distinta presentación pero la información es básicamente la misma. Dentro de la sección de código encontré la parte en la cual se generaban de forma individual:
Sub CartasMarcadas03()
' Exporta a PDF
Dim SQL As String
Dim Rs1 As Recordset
' Identifica las SubCuentas faltantes y agrega para estructurar la extracción.
SQL = "SELECT TblCartas03.[Folio Carta],TblCartas03.MCE"
SQL = SQL & " FROM TblCartas03"
SQL = SQL & " WHERE TblCartas03.MCE = 'x'"
ConsultaDatos SQL, Rs1
Rs1.MoveLast: Rs1.MoveFirst
Dim strMensaje As String
Dim IngRespuesta As Long
strMensaje = ("Te dispones a generar " & Rs1.RecordCount & " archivos de cartas marcadas....deseas continuar?")
IngRespuesta = MsgBox(strMensaje, vbYesNo + vbExclamation, "Aviso Importante")
If IngRespuesta = 7 Then
Exit Sub
End If
' Obtiene el número de subcuentas faltantes
Rs1.MoveFirst
Do Until Rs1.EOF
If Rs1.Fields(1) = "x" Then
DoCmd.SetWarnings False
'Descarga información de la SubCta.
TempVars!Rst = Rs1.Fields(0).Value
DoCmd.SetWarnings False
DoCmd.OutputTo acOutputReport, "InfCarta_Correo_03", "PDFFormat(*.pdf)", "C:\Cartas Correo\Cartas03\" & Rs1.Fields(0) & ".pdf", , , 0, acExportQualityPrint
TempVars!Rst = Null
End If
'Avanza registro de tabla SubCtas.
Rs1.MoveNext
Loop
' Libera variables de Objeto
Rs1.Close
Set Rs1 = Nothing
End Sub
Public Function ConsultaDatos(ByVal SQL As String, ByRef Rst As DAO.Recordset)
' -----------------------------------------------------------------------------------------------------------------------
' NOTAS: + Este procedimiento ejecuta sentencias: SELECT
' -----------------------------------------------------------------------------------------------------------------------
On Error Resume Next
Set Rst = CurrentDb.OpenRecordset(SQL)
If Err <> 0 Then
MsgBox "Se provoco un error debido a " & Err.Description
Rst.Close
Exit Function
End If
End Functiony lo modifique de esta forma:
Public Function ConsultaNSS()
Dim base As DataBase
Dim registro As Recordset
Dim NSS As String
Dim M1 As String
Dim SQL As String
Dim Rs1 As Recordset
Dim Rs2 As Recordset
Dim Rst As DAO.Recordset
Regresa:
NSS = ""
NSS = InputBox("Escriba el NSS a 11 posiciones")
If NSS = "" Then
End
ElseIf NSS = Null Then
End
ElseIf Len(NSS) = 11 Then
' Identifica las SubCuentas faltantes y agrega para estructurar la extracción, la expresión '"& &"' indica que se concatena el valor
SQL = "SELECT TblCartas.[Tipo Traspaso],TblCartas.NSS"
SQL = SQL & " FROM TblCartas"
SQL = SQL & " WHERE TblCartas.NSS = '" & NSS & "'"
ConsultaDatos SQL, Rs1
' Rs1.MoveLast: Rs1.MoveFirst
Rs1.MoveFirst
DoCmd.SetWarnings False
Select Case Rs1.Fields("Tipo Traspaso")
Case "01", "21", "24", "38", "55", "71", "72", "73", "74"
'TipoCarta = "A02"
SQL = "SELECT TblCartas02.[Folio Carta],TblCartas02.NSS"
SQL = SQL & " FROM TblCartas02"
SQL = SQL & " WHERE TblCartas02.NSS = '" & NSS & "'"
ConsultaDatos SQL, Rs1
Rs1.MoveFirst
DoCmd.SetWarnings False
TempVars!Rst = Rs1.Fields(0).Value
DoCmd.SetWarnings False
DoCmd.OutputTo acOutputReport, "InfCarta_Correo_02", "PDFFormat(*.pdf)", "C:\Cartas Correo\Cartas02\" & Rs1.Fields(0) & ".pdf", , , 0, acExportQualityPrint
TempVars!Rst = Null
' Libera variables de Objeto
Rs1.Close
Set Rs1 = Nothing
Case "25", "51", "57"
'TipoCarta = "A03"
SQL = "SELECT TblCartas03.[Folio Carta],TblCartas03.NSS"
SQL = SQL & " FROM TblCartas03"
SQL = SQL & " WHERE TblCartas03.NSS = '" & NSS & "'"
ConsultaDatos SQL, Rs1
Rs1.MoveFirst
Do Until Rs1.EOF
If Rs1.Fields("NSS") = M1 Then
DoCmd.SetWarnings False
TempVars!Rst = Rs1.Fields(0).Value
DoCmd.SetWarnings False
DoCmd.OutputTo acOutputReport, "InfCarta_Correo_03", "PDFFormat(*.pdf)", "C:\Cartas Correo\Cartas03\" & Rs1.Fields(0) & ".pdf", , , 0, acExportQualityPrint
TempVars!Rst = Null
' Libera variables de Objeto
' Rs1.Close
' Set Rs1 = Nothing
End If
End
Loop
Case Else
MsgBox "No se encontro el registro", vbOKOnly, ""
End Select
Beep
MsgBox "Listo", vbOKOnly, ""
Else
MsgBox "Captura un NSS valido", vbOKOnly, ""
GoTo Regresa
End If
End Function
Al principio le deje los if, pero me generaba documentos individuales por el total de registros, no solo por elunico que habia ingresado, le quite los if y ya me generaba un unico documento con el registro que habia ingresado, pero despues no se que hice y me genera un documento por el total de registros de la tabla, ¿en donde esta mi error o errores?, ojala me puedan ayudar
