Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
760to764
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
760to764
760to764
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Access anbindung an Excel

Access anbindung an Excel
04.05.2006 13:07:59
erko
Hallo zusammen,
ich habe ein Problem mit dieser Funktion.
Das habe ich in Access-VBA geschrieben und möchte das gerne in Excel-VBA übertragen.
Was muss ich dabei anpassen und wie?
Ich weis das die Verbindung zu Access fehl, wie bekomme ich das hin?
Erko
Public

Sub ExcelRecordsetClick()
Dim oExcel As Excel.Application, db As Dao.Database, rs As Dao.Recordset, i As Long
On Error Resume Next
Err.Clear
Set oExcel = GetObject(, "Excel.Application ")
If Err.Number <> 0 Then Set oExcel = CreateObject("Excel.Application")
On Error GoTo 0
oExcel.Visible = True
oExcel.Workbooks.Add
oExcel.ActiveSheet.Name = CStr(Me!Blatt)
Set db = CurrentDb
Set rs = db.OpenRecordset("qryAdresse", dbOpenSnapshot)
If Me!Spaltenk Then
For i = 0 To rs.Fields.Count - 1
oExcel.Cells(1, i + 1) = rs.Fields(i).Name
Next i
oExcel.Range("A2").Select
Else
oExcel.Range("A1").Select
End If
Dim xlApp As Excel.Application
Dim xlWorkbook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim xlRange As Excel.Range
Dim rstExport As Dao.Recordset
Dim ia, ib
Set db = CurrentDb
Set rstExport = db.OpenRecordset("qryAdresse", dbOpenSnapshot)
Do While Not rs.EOF
ia = ia + 1
For i = 0 To rs.Fields.Count - 1
oExcel.Cells(ia + 1, i + 1) = CStr(Nz(rs.Fields(i).Value, ""))
Next i
rs.MoveNext
Loop
oExcel.Range("A4") = "Test"
oExcel.Visible = True
Set oExcel = Nothing
Set rs = Nothing
Set db = Nothing
End Sub

Und das versuche ich mit Excel-VBA zu realisieren und bekomme es nicht hin:

Sub Access_Import1()
Dim ADOC As ADODB.Connection
Dim DBS As ADODB.Recordset
Dim AnzZeile As Integer
Dim i As Integer
Dim Nr As String
Dim SuchAbfrage As String
Dim PfadAccess As String
Dim TabNa As String
PfadAccess = "D:\07_GPS\01_Datenbank\Management Consulting.mdb"
TabNa = "Tabelle1"
On Error GoTo Fehlerbehandlung
Sheets(TabNa).Activate
Range("A1").Select
AnzZeile = Sheets(TabNa).Cells(Rows.Count, 1).End(xlUp).Row
Set ADOC = New ADODB.Connection
With ADOC
.Provider = "Microsoft.jet.oledb.4.0"
.Open "D:\07_GPS\01_Datenbank\Management Consulting.mdb"  'PfadAccess
End With
i = 2
Do While i <= 10 'AnzZeile
i = i + 1
Nr = CStr(Sheets(TabNa).Cells(i, 1).Value)
Nr = Format(Nr, "000000000000")
SuchAbfrage = "SELECT * FROM [STK] WHERE MatNr = '" & Nr & "'"
Set DBS = New ADODB.Recordset
With DBS
.Open Source:=SuchAbfrage, ActiveConnection:=ADOC, CursorType:=adOpenKeyset, LockType:=adLockOptimistic
End With
Sheets(TabNa).Activate
Range("B3").Select
'While Not DBS.EOF
'Set db = CurrentDb
'Set rstExport = db.OpenRecordset("qryAdresse", dbOpenSnapshot)
Dim ia, ib
Dim oExcel As Excel.Application
Do While Not DBS.EOF
ia = ia + 1
For i = 0 To DBS.Fields.Count - 1
oExcel.Cells(ia + 1, i + 1) = CStr(DBS.Fields(i).Value)
Next i
DBS.MoveNext
Loop
'    Columns("A:G").AutoFit
DBS.Close
Set DBS = Nothing
Loop
ADOC.Close
Set ADOC = Nothing
Exit Sub
Fehlerbehandlung:
MsgBox "Es ist ein Fehler aufgetreten!" & Err.Description
End Sub

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Access anbindung an Excel
04.05.2006 13:40:46
erko
Hallo,
ich habe es hingebkommen, nur eine kleine Sache.
Wie bekomme ich die gesammt Anzahl der Spalten aus der Tabelle herraus.
Denn ich bekomme nur die ersten Spalte aus der Tabelle herraus.

Sub Access_Import()
Dim Con As ADODB.Connection
Dim RecS As ADODB.Recordset
Dim intColIndex As Integer
Dim DBName As String
Dim Tabelle As String
Dim Bereich As Range
DBName = "D:\07_GPS\01_Datenbank\Management Consulting.mdb"
Tabelle = "Beratungsunternehmen"
'Bereich = "A10:D20"
Sheets(1).Activate
Set Bereich = ActiveSheet.UsedRange
'Set Bereich = Bereich.Cells(1, 1)
'ThisWorkbook.ActiveSheet.Cells(1, 1).Activate
'Datenbank öffnen---------------------------------------------------
Set Con = New ADODB.Connection
Con.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & DBName & ";"
Set RecS = New ADODB.Recordset
With RecS
'Access-Tabelle öffnen und alle Datensätze einlesen-------------
.Open Tabelle, Con, adOpenStatic, adLockOptimistic, adCmdTable
'.Open Source:=SuchAbfrage, ActiveConnection:=ADOC, CursorType:=adOpenKeyset, LockType:=adLockOptimistic
For intColIndex = 0 To RecS.Fields.Count - 1 'Hier soll die gesammt Spaltenanzahl erscheinen
Bereich.Offset(0, intColIndex).Value = RecS.Fields(intColIndex).Name
Next
'Daten in die Excel-Tabelle einfügen
'Bereich.Offset(1, 0).CopyFromRecordset RecS
Dim i As Integer
If 1 = 1 Then 'Me!Spaltenk Then
For i = 0 To RecS.Fields.Count - 1 'Hier soll die gesammt Spaltenanzahl erscheinen
ActiveSheet.Cells(1, i + 1) = RecS.Fields(i).Name
Next i
ActiveSheet.Range("A2").Select
Else
ActiveSheet.Range("A1").Select
End If
End With
Dim ia, ib
Do While Not RecS.EOF
ia = ia + 1
For i = 0 To RecS.Fields.Count - 1 'Hier soll die gesammt Spaltenanzahl erscheinen
ActiveSheet.Cells(ia + 1, i + 1) = CStr(RecS.Fields(i).Value)
Next i
RecS.MoveNext
Loop
RecS.Close
Set RecS = Nothing
Con.Close
Set Con = Nothing
End Sub

Anzeige
Hilfe
04.05.2006 14:31:40
erko
Hallo noch mal.
ich habe ein Problem mit Tabelle in Access die eine leerzeile beinhalten.
Tabelle = "Name Vorname"
RecS.Open Tabelle, Con, adOpenStatic, adLockOptimistic, adCmdTable
Hier entsteht als Fehlermeldung:
Laufzeitfehler '-2147217865 80040e37)
Das Microsoft Jet-Datenbankmodul findet die Eingangstabelle oder Abfrage 'Managent' nicht. Stellen Sie sicher, dass sie existiert und der Name richtig eingeben wurde.
Hilfe
Hilfe
04.05.2006 14:48:01
erko
Hallo noch mal.
ich habe ein Problem mit Tabelle in Access die eine leerzeile beinhalten.
Tabelle = "Name Vorname"
RecS.Open Tabelle, Con, adOpenStatic, adLockOptimistic, adCmdTable
Hier entsteht als Fehlermeldung:
Laufzeitfehler '-2147217865 80040e37)
Das Microsoft Jet-Datenbankmodul findet die Eingangstabelle oder Abfrage 'Managent' nicht. Stellen Sie sicher, dass sie existiert und der Name richtig eingeben wurde.
Hilfe
Anzeige
AW: Hilfe
04.05.2006 14:50:04
erkoo
Hier meine Import in Excel und die Datenbereichseingenschaften...:
Provider=Microsoft.Jet.OLEDB.4.0;
Password="";
User ID=Admin;
Data Source=D:\07_GPS\01_Datenbank\Management Consulting.mdb;
Mode=ReadWrite;
Extended Properties="";
Jet OLEDB:System database="";
Jet OLEDB:Registry Path="";
Jet OLEDB:Database Password="";
Jet OLEDB:Engine Type=5;
Jet OLEDB:Database Locking Mode=1;
Jet OLEDB:Global Partial Bulk Ops=2;
Jet OLEDB:Global Bulk Transactions=1;
Jet OLEDB:New Database Password="";
Jet OLEDB:Create System Database=False;
Jet OLEDB:Encrypt Database=False;
Jet OLEDB:Don't Copy Locale on Compact=False;
Jet OLEDB:Compact Without Replica Repair=False;
Jet OLEDB:SFP=False
Anzeige
AW: Hilfe
04.05.2006 14:57:27
erko
Hier die Lösung
Tabelle = "[Management Consulting]"

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige