Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1700to1704
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Keine Daten in Datenbank

Keine Daten in Datenbank
11.07.2019 08:07:33
Thomas
Hallo excelfreunde,
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

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Keine Daten in Datenbank
11.07.2019 14:42:08
mmat
Hallo,
der Code hat bei mir funktioniert ... naja, fast. Da steht viel drin, was ich nicht verstanden habe, also hab ich die unverständlichen Teile erstmal rausgeschmissen.
übrig bleibt:
Sub Daten_schreiben()
Dim ortderdatenbank As String, strCon As String
Dim Tabellenname As String
Dim strSQL As String, i As Integer
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")
ortderdatenbank = ThisWorkbook.Path & "\Database1.accdb"
Tabellenname = "Tabelle1"
strCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ortderdatenbank
strSQL = "SELECT * FROM " & Tabellenname & ""
Tabellenwahl = "Tabelle1"  'TBeinstellun.Range("e2")
objDBank.Open strCon
objRSet.Open strSQL, objDBank, 0, 3
For i = 999 To 992 Step -1
With objRSet
.AddNew
.Fields(1) = i 'Hier könnten weitere Felder mit Excel-Daten gefüllt werden.
.Update
End With
Next i
End Sub
Warum z. B. setzt du in der Schleife das Recordset neu auf eine andere Tabelle ?
Hih
MM
Anzeige
AW: Keine Daten in Datenbank
11.07.2019 16:40:21
Thomas
Hallo mmat,
perfekt jetzt klappt es bei mir auch super.
Hab rechtvielen dank für deine Hilfe. Ich hab auch noch den ganzen Tag getestet und nicht hinbekommen.
Jetzt läuft es aber perfekt.
Diese Zeile
Set objRSet = objDBank.OpenRecordset("Select * From TB_Test WHERE testnr=" & id & ";")
hatte ich vergessen zu löschen. Ich hatte parallel dazu noch versucht alle Datensätze zu ändern. Von daher stammt das noch.
Aber das hat bis jetzt auch noch nicht geklappt. da muss noch ein Wurm drin sein.
Kannst Du dir dies auch mal anschauen?
Hab schon mal vielen vielen dank für deine Hilfe.
mfg thomas
Sub Daten_aendern()
Dim ortderdatenbank As String, strCon As String
Dim Tabellenname As String
Dim strSQL As String, i As Integer
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")
ortderdatenbank = ThisWorkbook.Path & "\Mitglieder.mdb"
Tabellenname = "neuetabelle"
strCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ortderdatenbank
strSQL = "SELECT * FROM " & Tabellenname & ""
Tabellenwahl = "Tabelle1"  'TBeinstellun.Range("e2")
objDBank.Open strCon
objRSet.Open strSQL, objDBank, 0, 3
For i = 1 To Tabelle1.Cells(Tabelle1.Rows.Count, 1).End(xlUp).Row
id = Tabelle1.Range("A" & i)
If WorksheetFunction.IsNumber(id) Then
Set objRSet = objDBank.OpenRecordset("Select * From neuetabelle WHERE testnr=" & id & ";")
With objRSet
'If Not .EOF Then
.Edit
.Fields(1) = Tabelle1.Range("B" & i).Value
.Fields(2) = Tabelle1.Range("C" & i).Value
.Fields(3) = Tabelle1.Range("D" & i).Value
.Fields(4) = Tabelle1.Range("E" & i).Value
.Update
.Move 0, objRSet.LastModified
neueid = !testnr
End With
End If
Next i
End Sub

Anzeige
einen schaffe ich schon
12.07.2019 12:55:57
Thomas
Hallo Kollegen,
einen Datensatz kann ich schon ändern. Aber ich bekomme keine Schleife hin.
Weiss jemand eine Lösung?
habt schon mal rechtvielen dank für euer Interesse.
mfg thomas
Sub alle_Daten_aendern_12Versuch()
Dim ortderdatenbank As String
'Dim strCon As String
Dim Tabellenname As String
Dim strSQL As String, i As Integer
Dim objDBank  As Object
Dim objRSet As Object
Dim oFld As Object
Dim id As String
'Dim neuePersonNr As String
Dim sFilterKlausel As String
sFilterKlausel = "ID=1"
'sFilterKlausel = "testnr=1"
Set objDBank = CreateObject("ADODB.Connection")
Set objRSet = CreateObject("ADODB.Recordset")
ortderdatenbank = ThisWorkbook.Path & "\Mitglieder.mdb"
Tabellenname = "neuetabelle" 'TBeinstellun.Range("e2")
With objDBank
.Provider = "Microsoft.ACE.OLEDB.12.0" 'für Access 2013
.Properties("Persist Security Info") = "False"
.Properties("Data Source") = ortderdatenbank
.Open 'strCon
End With
strSQL = "SELECT * FROM " & Tabellenname & " " & sFilterKlausel
strSQL = "SELECT * FROM " & Tabellenname & ""     '& " " & sFilterKlausel & ""
'strSQL = objDBank.OpenRecordset("Select * From Tabellenname WHERE testnr=" & id & ";")
With objRSet
'.CursorLocation = 3 'adUseClient
.CursorType = 2 'adOpenDynamic
.LockType = 3 'adLockOptimistic
.Open strSQL, objDBank  ', 0, 3   ' keine Ahnung was das ist experementieren
'.Open Tabellenname, objDBank
'.Filter = sFilterKlausel 'Filter setzen, ID muss 1 sein!
End With
For i = 1 To Tabelle1.Cells(Tabelle1.Rows.Count, 1).End(xlUp).Row
id = Tabelle1.Range("A" & i)
'If WorksheetFunction.IsNumber(id) Then
'Set objRSet = objDBank.OpenRecordset("Select * From Tabellenname WHERE testnr=" & id & ";")
With objRSet
'If Not .EOF Then
'.Edit
'.AddNew
'            .Fields(1) = Tabelle1.Range("B" & i).Value
'            .Fields(2) = Tabelle1.Range("C" & i).Value
'            .Fields(3) = Tabelle1.Range("D" & i).Value
'            .Fields(4) = Tabelle1.Range("E" & i).Value
.Fields(1) = Tabelle1.Range("B1").Value
.Fields(2) = Tabelle1.Range("C1").Value
.Update
'.Move 0 ', objRSet.LastModified
'            neueid = !testnr
'End If
End With
'End If
Next i
'RecordSet schließen
objRSet.Close
'Datenbankverbindung schließen
objDBank.Close
Application.Cursor = xlDefault
Set objRSet = Nothing
Set objDBank = Nothing
End Sub

Anzeige
AW: Keine Daten in Datenbank
17.07.2019 07:18:27
Thomas
Hallo excelfreunde,
ich habe meine Datei umbebaut. So das ich diese Lösung nicht mehr benötige.
Habt rechtvielen dank für euer Interesse.
mfg thomas

87 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige