Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1280to1284
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

Daten von Excel --> Access

Daten von Excel --> Access
06.10.2012 14:42:38
Excel
Hallo zusammen!
Habe hier nach langer Suche einen Code gefunden, den ich nun Stück für Stück anpasse. Eigentlich bräuchte ich nur einen Code, der von Excel eine Datenreihe (A2:Z2) als neuen Datensatz anfügt. Ja, sorry, …ist sicherlich ganz einfach, stell mich dazu etwas blöd an.
Beim nachstehenden Code klappt das soweit, nur müsste ich mehrere Daten transferieren. Dieser Code lässt leider nur 10 Daten (Zellen) zu. Alle Versuche sind leider gescheitert. Auch die Abfrage über „Dummy“ ist eigentlich umsonst. Lieber würde ich noch eine Abfrage in Access ausführen lassen. Die heißt „alteDaten“.
Dim ADOC As New ADODB.Connection
Dim dbs As New ADODB.Recordset
Dim sPfad As String
Dim rBereich As Range, LRow As Long
With Sheets("Mitglieders")
Set rBereich = .Range("A2:J2").Offset(0, 10)
Sheets("Dummy").Range(rBereich.Address).FormulaR1C1 = _
"=IF(CONCATENATE(RC1,RC2,RC3,RC4,RC5,RC6,RC7,RC8,RC9,RC10)" & _
"CONCATENATE(Mitglieders!RC1,Mitglieders!RC2,Mitglieders!RC3,Mitglieders!RC4,Mitglieders!RC5,Mitglieders!RC6,Mitglieders!RC7,Mitglieders!RC8,Mitglieders!RC9,Mitglieders!RC10),1,"""")"
ADOC.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\Users\sg0815\Desktop\DCO_Arbeitsdaten.mdb;"
dbs.Open "tblDaten", ADOC, adOpenKeyset, adLockOptimistic
Sheets("Mitglieders").Activate
LRow = 2
Do Until .Cells(LRow, 1).Value = ""
If Sheets("Dummy").Cells(LRow, 12) = 1 Then
dbs.AddNew
dbs!Garten_Nr = .Cells(LRow, 1).Value
dbs!Anrede = .Cells(LRow, 2).Value
dbs!Vorname = .Cells(LRow, 3).Value
dbs!Nachname = .Cells(LRow, 4).Value
dbs!Strasse = .Cells(LRow, 5).Value
dbs!Ort = .Cells(LRow, 6).Value
dbs!Telefon = .Cells(LRow, 7).Value
dbs!Geboren = .Cells(LRow, 8).Value
dbs!Eintritt = .Cells(LRow, 9).Value
dbs!Mitgl_Jahre = .Cells(LRow, 10).Value
dbs.Update
End If
LRow = LRow + 1
Loop
dbs.Close
ADOC.Close
Set ADOC = Nothing
Set dbs = Nothing
End With
Exit Sub
fehler:
Sheets("Dummy").Columns(11).Value = ""
MsgBox "Es trat ein Fehler auf!"
dbs.Close
ADOC.Close
Set ADOC = Nothing
Set dbs = Nothing
End Sub
Herzlichen Dank im Voraus,
Lars

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Daten von Excel --> Access
06.10.2012 15:20:06
Excel
Hallo,
unten war auch schon eine Frage zum lesen, habe dass Bsp. zum schreiben umgebaut.
Sub Schreiben()
SchreibeDaten Tabelle1.Range("A2:Z2").Value2
CloseDB
End Sub
kommt als Code in Modul2
Option Explicit 
Dim oDB As Object 
Public oRS As Recordset 
Sub CloseDB() 
On Error Resume Next 
oRS.Close: Set oRS = Nothing 
oDB.Close: Set oDB = Nothing 
End Sub 
Function Oben_Database() As Boolean 
Dim sPath$ 
On Error Resume Next 
Set oDB = CreateObject("DAO.DBEngine.36") 
If oDB Is Nothing Then 
    Set oDB = CreateObject("DAO.DBEngine.35") 
End If 
If Not oDB Is Nothing Then 
    sPath = IIf(Right$(ThisWorkbook.Path, 1) = "\", ThisWorkbook.Path, ThisWorkbook.Path & "\") 
    Set oDB = oDB.OpenDatabase(sPath & "\Datenbank.mdb", False, False) 
    Oben_Database = True 
End If 
 
End Function 
 
Sub SchreibeDaten(ByVal ArrayData) 
Dim varFelder(), n&, nn& 
If Not Oben_Database Then 
    MsgBox "Keine Verbindung zur Datenbank!" 
    Exit Sub 
End If 
Set oRS = oDB.OpenRecordset("SELECT * FROM Tabelle1") 
 
With oRS 
    For n = 1 To Ubound(ArrayData) 
       .AddNew 
        For nn = 1 To Ubound(ArrayData, 2) 
            .Fields(nn) = ArrayData(n, nn) 
        Next nn 
    Next n 
    .Update 
End With 
End Sub 
Gruß Tino

Anzeige
AW: Daten von Excel --> Access
06.10.2012 16:08:48
Excel
Danke Tino für die schnelle Antwort :-)
Leider läuft der Code nicht durch. bei
Set oRS = oDB.OpenRecordset("SELECT * FROM Tabelle1")
setzt er immer einen Fehler. Habe (obwohl es nicht die richtige Tabelle ist) auch sicherheitshalber an dieser Stelle Daten eingefügt. Hilft leider nichts.
Noch eine Frage/Anmerkung. Die Excel und die Access-Dateien liegen auf unterschiedlichen Laufwerken. Das kann ich auch nicht ändern. Zum Test liegt die Access-Datenbank noch lokal, sie soll später aber auf den Server kommen. Also müsste ich dort doch den absoluten Pfad eingeben, damit er die Datenbank findet!?
Grüße,
Lars

Anzeige
AW: Daten von Excel --> Access
06.10.2012 16:23:02
Excel
Hallo,
wenn er die Datenbank nicht finden würde, würder der Code schon zuvor aussteigen.
Hier mein Beispiel:
https://www.herber.de/bbs/user/82003.zip
Gruß Tino

AW: Daten von Excel --> Access
06.10.2012 16:44:08
Excel
Ja, deine Beispieldateien funktioniert 
Ich habe jetzt mal versucht den Code entsprechend anzupassen
…
If Not oDB Is Nothing Then
sPath = IIf(Right$(ThisWorkbook.Path, 1) = "\", ThisWorkbook.Path, ThisWorkbook.Path & "\")
Set oDB = oDB.OpenDatabase("C:\Users\sg0815\Desktop\DCO_Arbeitsdaten.mdb;", False, False)
Oben_Database = True
End If
End Function
Sub SchreibeDaten(ByVal ArrayData)
Dim varFelder(), n&, nn&
If Not Oben_Database Then
MsgBox "Keine Verbindung zur Datenbank!"
Exit Sub
End If
Set oRS = oDB.OpenRecordset("SELECT * FROM Tabelle1")
…
Leider weiterhin die Fehlermeldung. Muss ich eventuell noch einen Verweis setzen?
Danke nochmals für die schnelle Rückmeldung,
Lars

Anzeige
AW: Daten von Excel --> Access
06.10.2012 16:55:23
Excel
Nachtrag
Die Fehlermeldung lautet:
Laufzeitfehler 438
Objekt unterstützt diese Eigenschaft oder Methode nicht
Gruß, Lars

AW: Daten von Excel --> Access
06.10.2012 18:57:40
Excel
Keiner eine Idee woran es liegen Kann?
:-(

AW: Daten von Excel --> Access
06.10.2012 19:46:22
Excel
habs geschafft :-)
Danke für die Unterstützung!

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige