problemas con el buscador en vb Hola a todos!
Despues de haber leido todos las cosas q me habeis dejado en el primer post que puse ahora me comienza a surgir bastantes problemas, algunos ya los e solucionado y otros no tengo ni idea donde esta el error y os tengo que pedir ayuda.
Mi aplicacion es un buscador q estoi realizando de cualquier base de datos que haya dentro del sistema donde estoy, consigo q me salga el nombre de las tablas en los combobox y despues el nombre de los campos que tiene cada tabla, pero el problema viene cuando quiero realizar la busqueda dentro de esa base de datos me da un error que es el siguiente " 13Type mismatch ". no consigo ver el error, creo que es mejor que deje el codigo asi es mas facil para vosotros entender lo que me pasa y lo que he puesto
el codigo:
Public ssql As String
Public mysql As String
Public myrcs As Recordset
Public cnn As connection
Public rcs As Recordset
Public datos As String
Dim i As Integer
Dim j As Integer
Dim tablatype() As String
Dim tablaname() As String
Private Sub Command1_Click()
CommonDialog1.CancelError = True
On Error GoTo errhandler
CommonDialog1.Flags = cdOFNHideReadOnly
CommonDialog1.DialogTitle = "Escoge la base de datos que quieres utilizar"
CommonDialog1.Filter = "Archivos de Microsoft Access" & _
"(*.mdb)|*.mdb|"
CommonDialog1.FilterIndex = 2
CommonDialog1.ShowOpen
datos = CommonDialog1.FileName
Text1 = Empty
abrir
i = Empty
Grid.Clear
cbotabla.Clear
cbocampo.Clear
cbotabla.SetFocus
Set vertabla = cnn.OpenSchema(adSchemaTables)
ReDim Preserve tablaname(0)
ReDim Preserve tablatype(0)
Do While Not vertabla.EOF
If vertabla!TABLE_TYPE = "TABLE" Then
tablaname(i) = vertabla!TABLE_NAME
i = i + 1
ReDim Preserve tablaname(i)
End If
vertabla.MoveNext
Loop
For j = 0 To i - 1
cbotabla.AddItem tablaname(j)
Next j
cnn.Close
Exit Sub
errhandler:
Exit Sub
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Command3_Click()
busca
End Sub
Sub busca()
On Error GoTo tu
Grid.Clear
abrir
Set cnn = New Recordset
ssql = "select * from " & cbotabla.Text
ssql = ssql & " where " & cbocampo.Text & " = '" & Text1.Text & "'"
rcs.open ssql, cnn
rcs.MoveFirst
With Grid
.Clear
For p = 0 To cbocampo.ListCount - 1
.Row = 0
.Col = p
.Text = rcs.Fields(p).Name
Next p
r = 1
Do While Not rcs.EOF
.Row = r
For p = 0 To cbocampo.ListCount - 1
.Col = p
.Text = rcs(rcs.Fields(p).Name)
Next p
r = r + 1
rcs.MoveNext
Loop
End With
Exit Sub
tu:
MsgBox Err.Number & Err.Description
End Sub
Private Sub cbocampo_GotFocus()
On Error GoTo gg
cbocampo.Clear
mysql = "select * from " & cbotabla.Text
abrir
Set myrcs = New Recordset
myrcs.open mysql, cnn
For m = 0 To 100
cbocampo.AddItem myrcs.Fields(m).Name
Next m
myrcs.Close
Exit Sub
gg:
End Sub
Public Function abrir()
On Error GoTo licen
Set cnn = New connection
cnn.open ("provider = microsoft.jet.oledb.4.0;data source=" & datos)
Exit Function
licen:
End Function
gracias por la ayuda que me puedan dar
__________________
do not distrub the dead
|