Buscar Dato en 3 tablas iguales vba

Dudas sobre código
Avatar de Usuario
bryger
Nivel 5
Mensajes: 196
Registrado: Mié Jul 06, 2016 12:24 pm

Buscar Dato en 3 tablas iguales vba

Mensajepor bryger » Mié Mar 03, 2021 5:36 am

Holas sres buenas tardes se me surge una duda existe algu ejemplo donde pueda buscar en un formulario mediante vba un campo en varias tablas iguales, sin utilizar una consulta de union solo vba ???

esto lo pregunte hace tiempo en un foro de access donde obtuve un código entero (cortesía de JJeferson Diaz) pero con solo dos tablas esta vez necesito que sean 3, 4,5 tablas como podria hacer?
el campo es tipo texto almacena numero unico no se repite y tiene el mismo nombre en las 3 tablas (DNI)
adjunto codigo

Código: Seleccionar todo

Sub BuscaDosRecordset(StrBuscar As String)
On Local Error GoTo VerError

'LAS VARIABLES QUE YA TE HE EXPLICADO PARA INICIAR UN RECORDSET
Dim bd As DAO.Database
Dim rs1 As DAO.Recordset 'EL PRIMER RECORDSET
Dim rs2 As DAO.Recordset 'EL SEGUNDO RECORDSET



'*****(NOTA PODEMOS HACER LOS RECORDSET QUE QUERAMOS DENTRO DE UNO SOLO)********

'ALMACENO VALORES COMO TE DIJE, DIM INTEGER AL INICIAR LA SUB SE VA A CERO, SI USARA LONG ALMACENA HASTA QUE CIERRE EL FORM
Dim a, b, c, d, e, i, j, k, m As Long


'ESTA UNA VARIABLE QUE CONVIERTO EN ARRAY PARA ALMACENAR VARIOS VALORES
Dim Contratante1(0 To 100) As String
Dim Contratante2(0 To 100) As String



'ESTAS VARIABLES PARA GUARDAR LOS RESULTADOS
Dim res1, res2, res3, Respuesta As String

'LE CARGO LOS OBJETOS A LAS VARIABLES DEL RECORDSET
Set bd = CurrentDb()
Set rs1 = bd.OpenRecordset("Moyobamba")
Set rs2 = bd.OpenRecordset("Iquitos")
Set rs3 = bd.OpenRecordset("Pucallpa")

'SI LA TABLA1 ESTA VACIA ME SALGO
If rs1.RecordCount = 0 Then MsgBox "No se encontro este cliente en Moyobamba", vbInformation, "Error": Exit Sub
'RECORRO LA PRIMERA TABLA
While Not rs1.EOF
'ALMACENO EN EL ARRAY QUIEN ES EL CONTRATANTE
If rs1!DNI = StrBuscar Then a = a + 1: Contratante1(a) = rs1![Nombre_Apellido]
'UN BUCLE PARA SABER SI LO QUE BUSCAS ESTA EN LA TABLA1
 Do While (StrBuscar)
 i = i + 1
 If rs1!DNI = StrBuscar Then j = j + 1
 If i > rs1.RecordCount Then Exit Do 'DETENGO EL BUCLE PARA NO HACERLO INFINITO
 Loop 'PASO AL OTRO PROCEDIMIETO
'ME MUEVO AL SIGUIENTE REGISTRO DE LA TABLA1
rs1.MoveNext
Wend 'PASO AL SIGUIENTE, HASTA TERMINAR CON LA TABLA1

'SI LA TABLA2 ESTA VACIA ME SALGO
If rs2.RecordCount = 0 Then MsgBox "No se encontro este cliente en Iquitos", vbInformation, "Error": Exit Sub
'RECORRO LA SEGUNDA TABLA
While Not rs2.EOF
'ALMACENO EN EL ARRAY QUIEN ES EL CONTRATANTE
If rs2!DNI = StrBuscar Then b = b + 1: Contratante2(b) = rs2![Nombre_Apellido]
'UN BUCLE PARA SABER SI LO QUE BUSCAS ESTA EN LA TABLA2
 Do While (StrBuscar)
 k = k + 1
 If rs2!DNI = StrBuscar Then m = m + 1
 If k > rs2.RecordCount Then Exit Do 'DETENGO EL BUCLE PARA NO HACERLO INFINITO
 Loop 'PASO AL OTRO PROCEDIMIETO
'ME MUEVO AL SIGUIENTE REGISTRO DE LA TABLA2
rs2.MoveNext
Wend 'PASO AL SIGUIENTE, HASTA TERMINAR CON LA TABLA2

'HAGO UN BUCLE PARA QUE ME DEVUELVA LOS ARRAY DEL CONTRATANTE Y SE LO ANEXO A LA VARIABLE res1 Y res2 y res3
For c = 1 To a: res1 = Contratante1(c) & " , " & res1: Next c
For d = 1 To b: res2 = Contratante2(d) & " , " & res2: Next d

'FIN DE LOS BUCLE

e = j & m 'ESTA VARIABLE ALMACENO LO ENCONTRADO

'POR AQUI ME INFORMO DE LOS RESULTADOS Y AGREGO A LA VARIABLE LO QUE ENCUENTRE EN EL SELECT CASE
Select Case e
Case 0
Respuesta = "No se encontro el DNI: " & StrBuscar & " En ninguna base de datos"
Case Is > 10
Respuesta = "Se ha encontrado el Cliente " & StrBuscar & " en las dos tablas" & vbCrLf & vbCrLf & _
"En la Tabla1 (" & a & ") " & IIf(a = 1, "vez", "veces") & " y ordenamos segun encontramos" & vbCrLf & _
"Su Nombre : " & Left(res1, Len(res1) - 2) & vbCrLf & vbCrLf & _
"En la Tabla2 (" & b & ") " & IIf(b = 1, "vez", "veces") & " y ordenamos segun encontramos" & vbCrLf & _
"Su Nombre : " & Left(res2, Len(res2) - 2) & vbCrLf & vbCrLf & _
"En la Tabla3 (" & x & ") " & IIf(x = 1, "vez", "veces") & " y ordenamos segun encontramos" & vbCrLf & _
"Su Nombre : " & Left(res3, Len(res3) - 2)
Case 10
Respuesta = "Se encontro el DNI  " & StrBuscar & vbCrLf & vbCrLf & _
"En la base de datos de MOYOAMBA " & vbCrLf & _
"Nombre del Cliente : " & Left(res1, Len(res1) - 2)
Case 1
Respuesta = "Se encontro el DNI  " & StrBuscar & vbCrLf & vbCrLf & _
"En la base de datos de IQUITOS " & vbCrLf & _
"Nombre del Cliente : " & Left(res2, Len(res2) - 2)
End Select

'INFORMO POR MSGBOX
MsgBox Respuesta, vbInformation, "Resultado"
'CIERRO TODO
rs1.Close
rs2.Close
bd.Close

'VACIO LAS VARIABLES
Set rs1 = Nothing
Set rs2 = Nothing
Set bd = Nothing

Exit Sub
VerError:
MsgBox "Error #  " & Err.Number & vbCrLf & Err.Description, vbInformation
End Sub

Volver a “Código VBA”

¿Quién está conectado?

Usuarios navegando por este Foro: No hay usuarios registrados visitando el Foro y 3 invitados