Daten aus access
30.10.2007 13:34:00
Kocky
ich probiere grade Daten von und nach access zu schreiben, das Schreiben nach access mittels UF habe ich hinbekommen. Probleme macht mir das auslesen der Daten.
folgender Code bleibt an der Stelle RecSet.Open SQLString, Connect, adOpenDynamic, adLockReadOnly hängen Hat Da jemand eine Idee zu ?
P.S. Code kommt von Peter Feustel aus dem Archiv
Gruß&Dank
kocky
Private Sub UserForm_Activate()
Dim path As String
Dim DBPfad As String ' Pfad der Access-Anwendung
Dim DBDatei As String ' Name der Access-Datei bzw. DB
Dim DBTab As String ' Name der Access-Tabelle
Dim Connect As Connection ' die Verbindung zu Access
Dim RecSet As Recordset ' der Access RecordSet
Dim SQLString As String ' der SQL Befehl
Dim iLiBoIndx As Integer ' ListBox-Index
Dim Suchbegr As String ' zum Suchen in der Access-Datenbank
Suchbegr = "Name"
' Pfad der Access Datenbank, Name der Access Datei, Name der Access Tabelle
DBPfad = "E:\Ertser\"
DBDatei = "db1.mdb"
DBTab = "allgemein1"
path = "E:\Erster\db1.mdb"
' die ListBox 'formatieren'
UserForm2.ListBox1.ColumnCount = 9
UserForm2.ListBox1.ColumnWidths = _
"3,0 cm; 3,5 cm; 3,0 cm; 3,2 cm; 1,0 cm; 1,5 cm; 3,5 cm; 3,5 cm; 1,0 cm"
' Die Datenbank öffnen
Set Connect = New ADODB.Connection
With Connect
.Provider = "Microsoft.Jet.OLEDB.4.0" ' für Access 2000 und höhere
.ConnectionString = path 'DBPfad & DBDatei
.Open
End With
' hier nur ein paar Felder gemäß Suchbegiff aus der Access-Tabelle holen
SQLString = "SELECT " & DBTab & ".Name," ' _
& " FROM " & DBTab & ";"
'& DBTab & ".Vorname, " _
'& DBTab & ".Geburtsdatum, " _
" FROM " & DBTab & ";"
'& " WHERE " _
'& DBTab & ".Nachname Like '" & Suchbegr & "';"
If SQLString = "" Then
MsgBox "hier ist der Wurm drin, der SQLString ist leer - Abbruch.", _
16, " der SQLString wurde nicht gefüllt."
Exit Sub
Else
MsgBox SQLString ' den SQL-String anzeigen
End If
Set RecSet = New ADODB.Recordset
RecSet.Open SQLString, Connect, adOpenDynamic, adLockReadOnly
' Jetzt den selektierten Record holen und in die ListBox schreiben
If RecSet.EOF = False Then ' kein EOF => es gibt also Daten !
RecSet.MoveFirst ' auf dem ersten Datensatz aufsetzen
Else
MsgBox "es konnte nichts selektiert werden => Abbruch.", _
16, " fehlerhafte Selektion ?"
Exit Sub
End If
Do While RecSet.EOF = False
UserForm2.ListBox1.AddItem " "
If RecSet.Fields.Item(0).Value "" Then
UserForm2.ListBox1.List(iLiBoIndx, 0) = RecSet.Fields.Item(0).Value
End If
If RecSet.Fields.Item(1).Value "" Then
UserForm2.ListBox1.List(iLiBoIndx, 1) = RecSet.Fields.Item(1).Value
End If
If RecSet.Fields.Item(2).Value "" Then
UserForm2.ListBox1.List(iLiBoIndx, 2) = RecSet.Fields.Item(2).Value
End If
If RecSet.Fields.Item(3).Value "" Then
UserForm2.ListBox1.List(iLiBoIndx, 3) = RecSet.Fields.Item(3).Value
End If
iLiBoIndx = iLiBoIndx + 1
RecSet.MoveNext
Loop
RecSet.Close ' Access Recordset schließen
Connect.Close ' Access schließen
End Sub