Keine Daten in Datenbank
11.07.2019 08:07:33
Thomas
ich versuche gerade mit dem unten stehenden Makro alle Daten aus der Tabelle3 in eine Accessdatenbank zu schreiben.( Late Binding )
Nach vielen vielen testen habe ich es hinbekommen das kein Fehler mehr auftritt.
Leider landen aber auch keine Daten in der Datenbank.
Kann jemand von euch sehen woran dies liegen könnte?
Oder hat vielleicht jemand ein Beispiel für mich auf der Platte? Vielleicht kann ich mir dies dann an meine Umgebung anpassen.
Sub Daten_schreiben()
Dim ortderdatenbank As String, strCon As String
Dim Tabellenname As String
Dim strSQL As String, i As Integer
'Late Binding - kein gesetzter Verweis erforderlich
Dim objDBank As Object
Dim objRSet As Object
Dim oFld As Object
Dim id As String
Dim Tabellenwahl As String
Dim neuePersonNr As String
Set objDBank = CreateObject("ADODB.Connection")
Set objRSet = CreateObject("ADODB.Recordset")
'Set oFld = CreateObject("ADODB.Field")
'Dim gültige_datenbank As String
ortderdatenbank = Tabfund.Range("q1")
'ortderdatenbank = ThisWorkbook.Path & "\datenbank.accdb" 'Hierhin wird exportiert
Tabellenname = "Test"
'Datenverbindung
strCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ortderdatenbank
strSQL = "SELECT * FROM " & Tabellenname & ""
Tabellenwahl = "test" 'TBeinstellun.Range("e2")
'Datenverbindung öffnen
objDBank.Open strCon
'Filter setzen
objRSet.Open strSQL, objDBank, 0, 3
For i = 1 To Tabelle3.Cells(Tabelle3.Rows.Count, 1).End(xlUp).Row 'Tabelle3.Range("A:A"). _
_
SpecialCells(xlCellTypeConstants).Count
id = Tabelle3.Range("A" & i)
If WorksheetFunction.IsNumber(id) Then
Set objRSet = objDBank.OpenRecordset("Select * From TB_Test WHERE testnr=" & id & ";")
With objRSet
'If Not .EOF Then
.AddNew
.Fields(1) = Tabelle3.Range("B" & i).Value
.Fields(2) = Tabelle3.Range("C" & i).Value
.Fields(3) = Tabelle3.Range("D" & i).Value
.Fields(4) = Tabelle3.Range("E" & i).Value
.Update
.Move 0, objRSet.LastModified ' neu
neuePersonNr = !testnr
End With
End If
Next i
End Sub
habt schon mal rechtvielen dank für euer Interesse.
mfg thomas