ADODB Filter
08.12.2021 08:12:56
Thomas
ich habe ein Projekt das ich verwirklichen möchte.
Ich habe ein Tabellenblatt wo ich den Impfstatus per UserForm eintrage, die Daten werden in einer Access Datenbank gespeichert. Es sollen ja mehrere Personen mit der Liste Arbeiten.
Wenn ich ein Doppelklick auf die Zelle mache um das Datum zu ändern bekomme ich immer ein Laufzeitfehler 3001 Die Argumente sind vom Falschen Typ, liegen außerhalb des Gültigkeitsbereiches oder sind miteinander unvereinbar
In der Spalte A befinden sich die PersonalNr und in der Zeile 5 befindet sich der Name der Impfung.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim letzteSpalte As Long
Dim letzteZeile As Long
strDBName = Sheets("Daten").Range("C3").Value
strDBPath = Sheets("Daten").Range("C2").Value
strDBFullName = strDBPath & "\" & strDBName
letzteSpalte = Sheets("Status Impfen").Cells(5, Columns.Count).End(xlToLeft).Column
letzteZeile = Sheets("Status Impfen").Cells(Rows.Count, 1).End(xlUp).Row
'If Not Intersect(Target, Range("F6:S310")) Is Nothing Then 'Impfbereich
If Not Intersect(Target, Range(Cells(6, 6), Cells(letzteZeile, letzteSpalte))) Is Nothing Then 'Impfbereich
'Wenn ein eintag schon vorhanden, dann werden die Daten Angezeigt
If Not IsNumeric(ActiveSheet.Cells(Target.Row, Target.Column)) Then
strImpfen = True
ADOCnn.Open "Provider=Microsoft.ACE.OLEDB.16.0; Data Source=" & strDBFullName & ";Jet OLEDB:Database Password=" & strDBPasswort
ADOTab.Open "tblImpfung", ADOCnn, adOpenDynamic, adLockOptimistic
ADOTab.MoveFirst
ADOTab.Filter = "PersNr=" & ActiveSheet.Cells(Target.Row, 1).Value & " AND " & "Impfung=" & ActiveSheet.Cells(5, Target.Column).Value
frm_Impfen.txtPersNr = ADOTab!PersNr
frm_Impfen.cboImpfung = ADOTab!Impfung
frm_Impfen.txtDatum = ADOTab!Datum
ADOTab.Close
ADOCnn.Close
Set ADOTab = Nothing
Set ADOCnn = Nothing
frm_Impfen.Show
Else
'kein Eintrag vorhanden
With Target
frm_Impfen.txtPersNr = ActiveSheet.Cells(Target.Row, 1).Value
frm_Impfen.cboImpfung = ActiveSheet.Cells(5, Target.Column).Value
strImpfen = False
frm_Impfen.Show
End With
End If
End If
End Sub
Gruß
Thomas