RE:buscar un registro en access desde un formulari
Hola Javier mira yo he realizado consultas con formularios desde excel, te paso un codigo y tu lo adecuas para tu programa.
Al ver tu codigo no veo que barras los registros yo uso el Do Loop
Ejemplo:
Do While Not rstDownloadInfo.EOF
'***** Esto se mueve registro por registro.
rstDownloadInfo.MoveNext
Loop
Aqui el programa espero te sirva :-) Copialo y pegalo luego lo adecuas
Public Sub DownloadInfo()
Dim dbsObj As Database
Dim qryDownloadInfo As QueryDef
Dim rstDownloadInfo As Recordset
Dim i As Integer
Dim j As Integer
Dim k As Integer
Set dbsObj = DBEngine.Workspaces(0).OpenDatabase("C:DataBaseFixuresRelationshipBrice.mdb")
'****Esta es la consulta los parametros son parShape, parNumber, parWide******
'****Selecciona todos los datos (SELECT *) de la tabla (Molds) donde
'****Shape de la tabla = al parametro que tu pones en excel y Food_Tray_Wide de tabla que tanto el Shape como el FoodTray son los nombres de los campos de la tabla de access. La tabla es Molds y los campos Shape y Food Tray
'****No olvides incluir el tipo de datos del parametro, en este caso son numericos
'****Pero pueden ser de tipo Text, ej. parNombre Text
Set qryDownloadInfo = dbsObj.CreateQueryDef("", "PARAMETERS parShape Number, parWide Number; " & _
"SELECT * " & _
"FROM Molds " & _
"WHERE Shape=[parShape] and Food_Tray_Wide=[parWide]; ")
'Aqui toma los datos de la hoja de excel y las coloca en el parametro para la consulta
qryDownloadInfo.Parameters!parWide = Worksheets("Capture").Cells(11, 2).Value
qryDownloadInfo.Parameters!parShape = Worksheets("Capture").Cells(13, 2).Value
Set rstDownloadInfo = qryDownloadInfo.OpenRecordset(dbOpenDynaset)
i = 2
j = i
k = i
'Esto es por si no se encuentra ningun registro EOF = End of Field
'BOF = Begin of Field
If rstDownloadInfo.EOF = True And rstDownloadInfo.BOF = True Then
MsgBox "No se encontró Food Tray"
Exit Sub
Else
'****** Esto barre los registros hasta el ultimo y los arroja en el excel.
Do While Not rstDownloadInfo.EOF
If IsNull(rstDownloadInfo!Food_Tray_Wide) = False Then
Worksheets("Consult").Cells(i, 2).Value = rstDownloadInfo!Food_Tray_Wide
End If
If IsNull(rstDownloadInfo!Shape) = False Then
Worksheets("Consult").Cells(i, 3).Value = rstDownloadInfo!Shape
End If
If IsNull(rstDownloadInfo!Mold_Number) = False Then
Worksheets("Consult").Cells(i, 4).Value = rstDownloadInfo!Mold_Number
End If
If IsNull(rstDownloadInfo!Status) = False Then
Worksheets("Consult").Cells(i, 5).Value = rstDownloadInfo!Status
If rstDownloadInfo!Status <> "OK" Then
Worksheets("Consult").Activate
Worksheets("Consult").Range("D" & i, "E" & i).Select
With Selection.Interior
.ColorIndex = 3
.Pattern = xlSolid
End With
End If
End If
i = i + 1
rstDownloadInfo.MoveNext
Loop
End If
'****Esto cierra las consultas es importante para liberar la memoria
rstDownloadInfo.Close
qryDownloadInfo.Close
End Sub
Saludos desde Mexicali B.C. Mexico
Ing. Zeus Alberto Páez Rentería
Project Engineer
Department of Desing and Product
Triumph Group Division Aerospace