Datensätze
22.05.2004 23:52:45
Jens
Ich benötige Eure Hilfe. Ich habe folgenden Code der meie csv dateien in eine Access Datenbank importiert nur habe ich ein problem der code müsste so umgeschrieben werden das er einen bestehenden Datensatz updatet.
kann mir jemand helfen? bin sehr dankbar.
Gruß Jens
'Dateiname der Datenbank
Public Const Dateiname = "I:\Dat\Datenbank.mdb"
'Tabellenname in der Datenbank
Public Const Tabellenname = "Auswertung"
Dim Datenbank As Database
Dim Datensatz As Recordset
Dim Tabelle As TableDef
'Erzeugen der Datenbank und Tabelle
Public
Sub Datenbank_und_Tabelle_erzeugen()
Dim Feld1 As Field
Dim Feld2 As Field
Dim Feld3 As Field
Dim Feld4 As Field
Dim Feld5 As Field
Dim Feld6 As Field
'On Error Resume Next
'Prüfen, ob Datenbank bereits vorhanden
If Dir(Dateiname) = "" Then
'falls nicht, neu erzeugen
Set Datenbank = CreateDatabase(Dateiname, dbLangGeneral, dbEncrypt)
Else
'ansonsten öffnen
Set Datenbank = OpenDatabase(Dateiname)
End If
'Prüfen, ob Tabelle bereits vorhanden
If Not TableExists(Dateiname, Tabellenname) Then
'Tabelle erzeugen
Set Datenbank = OpenDatabase(Dateiname)
Set Tabelle = Datenbank.CreateTableDef(Tabellenname)
'Felder erzeugen
'Die Namen der Felder werden aus den
'entsprechenden Zellen geholt
With Tabelle
Set Feld1 = .CreateField(Range("B2"), dbText, 20)
Set Feld2 = .CreateField(Range("C2"), dbText, 20)
Set Feld3 = .CreateField(Range("D2"), dbDate)
Set Feld4 = .CreateField(Range("E2"), dbDate)
Set Feld5 = .CreateField(Range("F2"), dbMemo)
Set Feld6 = .CreateField(Range("G2"), dbMemo)
.Fields.Append Feld1
.Fields.Append Feld2
.Fields.Append Feld3
.Fields.Append Feld4
.Fields.Append Feld5
.Fields.Append Feld6
End With
'Tabelle hinzufügen
Datenbank.TableDefs.Append Tabelle
End If
'Datenbank schliessen
Datenbank.Close
If Err.Number <> 0 Then MsgBox Err.Description
End Sub
'Daten aus einem Bereich in die Datenbank schreiben
Public
Sub Daten_schreiben()
'Prüfen, Tabelle existiert
If Not TableExists(Dateiname, Tabellenname) Then
MsgBox "Datenbank oder Tabelle ist nicht vorhanden !", vbExclamation
Exit Sub
End If
'Datenbank und Tabelle öffnen
Set Datenbank = OpenDatabase(Dateiname)
Set Datensatz = Datenbank.OpenRecordset(Tabellenname)
With Datensatz
'Bereich B3:E22
For x = 3 To Sheets("Rädercode").[H6]
.AddNew
For y = 2 To 7 'Spalte 2 bis 7
.Fields(Cells(2, y)).Value = Cells(x, y).Text
Next y
'Datensatz updaten
.Update
.Bookmark = .LastModified
Next x
End With
Datenbank.Close
End Sub
'Tabelle löschen
Public
Sub Tabelle_löschen()
'Datenbank zum Löschen öffnen
Set Datenbank = OpenDatabase(Dateiname)
'Tabelle löschen
Datenbank.TableDefs.Delete Tabellenname
'Datenbank schliessen
Datenbank.Close
End Sub
'Prüft, ob eine Tabelle in einer
'Datenbank bereits vorhanden ist
Public
Function TableExists(Dateiname, MyTableName)
Dim i
'Prüfen, ob die Datenbank existiert
If Dir(Dateiname) = "" Then
TableExists = False
Exit Function
End If
'Datenbank öffnen
Set Datenbank = OpenDatabase(Dateiname)
TableExists = False
'alle Tabellen durchlaufen
For i = 0 To Datenbank.TableDefs.Count - 1
If Datenbank.TableDefs(i).Name = MyTableName Then
TableExists = True
Exit Function
End If
Next i
Datenbank.Close
End Function