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 Function

y 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