|
Hi ich würde gerne "wiederholen" in Inputfeld bis gesuchten Daten in Datenbank vorhanden sind. Leider geht das bei mir nur einmal.
Private Sub cmdSucheKdName_Click()
On Error GoTo Mldg
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL As String
Dim strName As String
Dim strName2 As String
Dim intAnz As Integer
Dim strMsg As String
Dim intI As Integer
Dim intWahl As Integer
Dim intWahl2 As Integer
strName2 = _
InputBox("Geben Sie einen mit Sternen * eingefassten " & vbCr & _
"Suchbegriff ein.")
If strName2 = "" Then Exit Sub
Set db = CurrentDb()
strSQL = "SELECT * FROM tblMieter WHERE Bemerkungen like '" & strName2 & "'"
Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)
If rs.RecordCount = 0 Then
intWahl = MsgBox("Suchkriterium wurde nicht gefunden", vbRetryCancel, "Suchkriterium")
End If
If intWahl = vbRetry Then
strName = _
InputBox("Geben Sie einen mit Sternen * eingefassten " & vbCr & _
"Suchbegriff ein.")
If strName = "" Then Exit Sub
Set db = CurrentDb()
strSQL = "SELECT * FROM tblMieter WHERE Bemerkungen like '" & strName & "'"
Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)
rs.MoveLast
intAnz = rs.RecordCount
MsgBox "Ihr Kriterium hat " & intAnz & " Datensätze gefunden: "
rs.MoveFirst
strMsg = _
"Folgende " & intAnz & " Gäste mit: " & strName & " wurden gefunden:" & vbCr & vbCr
For intI = 1 To intAnz
strMsg = strMsg & "Name: " & rs("Vorname") & " " & rs("Name") & ", " _
& "in " & rs("Ort") & ", " & "TelNr. " & rs("TelNr") & vbCr
rs.MoveNext
Next intI
rs.Close
MsgBox strMsg, vbOKOnly + vbInformation, "Ihre Suchergebnisse"
Exit Sub
If vbRetry Then
strName
ElseIf intWahl = vbCancel Then
Exit Sub
End If
rs.MoveLast
intAnz = rs.RecordCount
MsgBox "Ihr Kriterium hat " & intAnz & " Datensätze gefunden: "
rs.MoveFirst
strMsg = _
"Folgende " & intAnz & " Gäste mit: " & strName2 & " wurden gefunden:" & vbCr & vbCr
For intI = 1 To intAnz
strMsg = strMsg & "Name: " & rs("Vorname") & " " & rs("Name") & ", " _
& "in " & rs("Ort") & ", " & "TelNr. " & rs("TelNr") & vbCr
rs.MoveNext
Next intI
rs.Close
MsgBox strMsg, vbOKOnly + vbInformation, "Ihre Suchergebnisse"
Exit Sub
Mldg:
MsgBox "Fehlerbeschreibung: " & Err.Description & vbCr & _
"Fehlernummer: " & Err.Number
End Sub
|