volly86
20-07-2009, 09:30
Ciao a tutti, spero di aver postato nella sezione giusta:
Ho un db in access 2003 con una funzione di ricerca trovata in internet e che
avevo adattato alle mie esigenze, ma, convertendo il db in access 2007 non
funziona più! L'errore che mi da quando arriva al punto indicato sotto è
"Record non corrispondente"
La funzione cerca viene richiamata al click di un pulsante in questo modo
Dim fun as new clsUtility
Private Sub attivaRicerca_Click() 'OK
Call fun.cerca(Me, Forms!Atleti)
End Sub
il codice della funzione di ricerca è questo
Private rst As Recordset
Private nomeCampo As Field
Private strValoreCampo, strCampoSingolo As String
Private contaTrovate As Integer
Private trovatoQualcosa, trovataParola, chkParolaEsatta As Boolean
Function cerca(meValue As Object, maschera As Form)
Set rst = maschera.RecordsetClone ==> SI BLOCCA QUI
strValoreCampo = ""
strCampoSingolo = ""
trovatoQualcosa = False
trovataParola = False
chkParolaEsatta = True
If Not meValue!chkGiaTrovata Then
rst.MoveFirst
contaTrovate = 0
Else
rst.Bookmark = meValue.Bookmark
rst.MoveNext
End If
If meValue!campoSingolo = True Then
strCampoSingolo = meValue!elencoCampoSingolo.Value
End If
Do While Not rst.EOF
For Each nomeCampo In rst.Fields
If meValue!campoSingolo Then
If nomeCampo.Name = strCampoSingolo Then 'Or rst.EOF Then
res = subCerca(meValue, maschera)
If res = selectOption.OK Then Exit Do
Exit For
End If
Else
res = subCerca(meValue, maschera)
If res = selectOption.OK Then Exit Do
End If
Next
rst.MoveNext
Loop
If contaTrovate = 0 Then
msgReturn = MsgBox("Elemento non trovato", vbInformation + vbOKOnly,
"Nessun risultato")
ElseIf rst.EOF Then
msgReturn = MsgBox("Ricerca Terminata!" & vbCrLf & _
"Per ripartire dal primo record" & vbCrLf & _
"fare click sul tasto di ricerca", vbInformation
+ vbOKOnly, "Fine")
End If
Set rst = Nothing
Set nomeCampo = Nothing
End Function
Private Function subCerca(meValue As Object, maschera As Form) As Integer
Dim strCampoRicerca As String
If Not nomeCampo.Name = "Foto" And Not nomeCampo.Name = "Percorso Cert. PDF"
And Not rst.EOF Then
strValoreCampo = Nz(rst(nomeCampo.Name), "")
strCampoRicerca = Nz(meValue!Ricerca, "")
If meValue!parolaIntera Then
If InStr(1, strValoreCampo, meValue!Ricerca & IIf(chkParolaEsatta, "
", "")) = Nz(strValoreCampo, "") Or strValoreCampo = strCampoRicerca Then
trovatoQualcosa = True
trovataParola = True
End If
Else
If Not trovataParola Then
If InStr(1, strValoreCampo, meValue!Ricerca) > 0 Then
trovatoQualcosa = True
trovataParola = True
End If
End If
End If
If trovataParola Then
meValue!chkGiaTrovata = True
contaTrovate = contaTrovate + 1
meValue.Bookmark = rst.Bookmark
If meValue(nomeCampo.Name).Enabled = True Then
meValue("[" & nomeCampo.Name & "]").SetFocus
meValue(nomeCampo.Name).SelStart = InStr(1, meValue!Ricerca,
Nz(meValue(nomeCampo.Name).Value, ""))
meValue(nomeCampo.Name).SelLength = Len(meValue!Ricerca)
End If
subCerca = selectOption.OK
Exit Function
Else
meValue!chkGiaTrovata = False
End If
End If
End Function
Ora, sarà sicuramente cambiato qualcosa nella gestione dei recordset ma
guardando la documentazione non mi sembra.
Ho un db in access 2003 con una funzione di ricerca trovata in internet e che
avevo adattato alle mie esigenze, ma, convertendo il db in access 2007 non
funziona più! L'errore che mi da quando arriva al punto indicato sotto è
"Record non corrispondente"
La funzione cerca viene richiamata al click di un pulsante in questo modo
Dim fun as new clsUtility
Private Sub attivaRicerca_Click() 'OK
Call fun.cerca(Me, Forms!Atleti)
End Sub
il codice della funzione di ricerca è questo
Private rst As Recordset
Private nomeCampo As Field
Private strValoreCampo, strCampoSingolo As String
Private contaTrovate As Integer
Private trovatoQualcosa, trovataParola, chkParolaEsatta As Boolean
Function cerca(meValue As Object, maschera As Form)
Set rst = maschera.RecordsetClone ==> SI BLOCCA QUI
strValoreCampo = ""
strCampoSingolo = ""
trovatoQualcosa = False
trovataParola = False
chkParolaEsatta = True
If Not meValue!chkGiaTrovata Then
rst.MoveFirst
contaTrovate = 0
Else
rst.Bookmark = meValue.Bookmark
rst.MoveNext
End If
If meValue!campoSingolo = True Then
strCampoSingolo = meValue!elencoCampoSingolo.Value
End If
Do While Not rst.EOF
For Each nomeCampo In rst.Fields
If meValue!campoSingolo Then
If nomeCampo.Name = strCampoSingolo Then 'Or rst.EOF Then
res = subCerca(meValue, maschera)
If res = selectOption.OK Then Exit Do
Exit For
End If
Else
res = subCerca(meValue, maschera)
If res = selectOption.OK Then Exit Do
End If
Next
rst.MoveNext
Loop
If contaTrovate = 0 Then
msgReturn = MsgBox("Elemento non trovato", vbInformation + vbOKOnly,
"Nessun risultato")
ElseIf rst.EOF Then
msgReturn = MsgBox("Ricerca Terminata!" & vbCrLf & _
"Per ripartire dal primo record" & vbCrLf & _
"fare click sul tasto di ricerca", vbInformation
+ vbOKOnly, "Fine")
End If
Set rst = Nothing
Set nomeCampo = Nothing
End Function
Private Function subCerca(meValue As Object, maschera As Form) As Integer
Dim strCampoRicerca As String
If Not nomeCampo.Name = "Foto" And Not nomeCampo.Name = "Percorso Cert. PDF"
And Not rst.EOF Then
strValoreCampo = Nz(rst(nomeCampo.Name), "")
strCampoRicerca = Nz(meValue!Ricerca, "")
If meValue!parolaIntera Then
If InStr(1, strValoreCampo, meValue!Ricerca & IIf(chkParolaEsatta, "
", "")) = Nz(strValoreCampo, "") Or strValoreCampo = strCampoRicerca Then
trovatoQualcosa = True
trovataParola = True
End If
Else
If Not trovataParola Then
If InStr(1, strValoreCampo, meValue!Ricerca) > 0 Then
trovatoQualcosa = True
trovataParola = True
End If
End If
End If
If trovataParola Then
meValue!chkGiaTrovata = True
contaTrovate = contaTrovate + 1
meValue.Bookmark = rst.Bookmark
If meValue(nomeCampo.Name).Enabled = True Then
meValue("[" & nomeCampo.Name & "]").SetFocus
meValue(nomeCampo.Name).SelStart = InStr(1, meValue!Ricerca,
Nz(meValue(nomeCampo.Name).Value, ""))
meValue(nomeCampo.Name).SelLength = Len(meValue!Ricerca)
End If
subCerca = selectOption.OK
Exit Function
Else
meValue!chkGiaTrovata = False
End If
End If
End Function
Ora, sarà sicuramente cambiato qualcosa nella gestione dei recordset ma
guardando la documentazione non mi sembra.