|
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
Dim lAnzahl As Integer
Anf:
lAnzahl = InputBox("Wie oft soll das Makro laufen ?", , 3)
' Prüfen ob eine Zahl eingegeben wurde
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
ElseIf intWahl = vbCancel Then
Exit Sub
Else
GoTo Anf
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
|