access db Spalte importieren

Guten Morgen Guten Morgen,
ich würde gerne eine Access DB per vba in ein Tabellenblatt importieren.
Bzw eigentlich brauche ich nur die eine Spalte davon, aber wenn es einfacher ist, alles zu importieren, auch ok.

Option Explicit
Sub accessimport()
Dim importdatei As String
Dim meDB As Database, DBTab As Recordset
Dim vonDatum As Long, bisDatum As Long
Dim A As Long
importdatei = Application.GetOpenFilename
Do Until importdatei  "Falsch"
importdatei = Application.GetOpenFilename
Loop
Set ws = ActiveWorkbook.Sheets("Tabelle3")
With ws.QueryTables.Add(Connection:="TEXT;" & importdatei, Destination:=ws.Range("A2"))
.TextFileParseType = xlDelimited
.TextFileCommaDelimiter = True
.Refresh
End With
vonDatum = CDate("02.05.2009") 'von Datum
bisDatum = CDate("29.05.2009") 'bis Datum
A = 2 'erste Zelle
'Zellen leer machen
Range("A2", Cells(Cells.SpecialCells(xlCellTypeLastCell).Row, 2)).ClearContents
'öffne Datenbank
Set meDB = OpenDatabase(importdatei)
'öffne Recordset
Set DBTab = meDB.OpenRecordset("SELECT Ab_VerschrottungTeile_Nr.von_Barcode,  _
Ab_VerschrottungTeile_Nr.Wert FROM Ab_VerschrottungTeile_Nr")
'Filter Recordset
DBTab.Filter = "Tabelle1.Datum >= " & vonDatum & " And Tabelle1.Datum

Das funktioniert so natürlich nichtmal ansatzweise.
Habe hier das gefunden mit einer Testdatei dazu udn hab versucht es anzupassen. Kläglich gescheitert :(
Grundsätzlich wird die Datei ("Scrap_2017.accdb") im Dateiexplorer ausgewählt ("importdatei"). Die Tabelle darin heißt "Ab_VerschrottungTeile_Nr" und die Spalte die er importieren soll hat die Überschrift "von_Barcode"
Die Spalte soll vollständig importiert werden.
Jmd ne Idee?

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

' ********************************************************************** ' Modul: Modul2 Typ: Allgemeines Modul ' ********************************************************************** Option Explicit Sub accessimport() Dim importdatei As String Dim objADO As Object, objWS As Worksheet importdatei = Application.GetOpenFilename Do Until importdatei <> "Falsch" importdatei = Application.GetOpenFilename Loop Set objWS = ActiveWorkbook.Sheets("Tabelle3") With objWS .Range("A2", .Cells(.Cells.SpecialCells(xlCellTypeLastCell).Row, 2)).ClearContents Set objADO = ADO_Access(impotdatei, "Ab_VerschrottungTeile_Nr", "von_Barcode") .Range("A2").CopyFromRecordset objADO End With Set objADO = Nothing Set objWS = Nothing End Sub Private Function ADO_Access(ByVal dbFile As String, ByVal TableName As String, Optional Fields As String = "*", Optional WhereString As String = "") As Object Dim objCon As Object Dim SQL As String, Con As String On Error GoTo ErrorHandler If ((GetAttr(dbFile) And vbDirectory) <> vbDirectory) Then Con = "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & dbFile & ";" & _ "Jet OLEDB:Engine Type=5;" & "Persist Security Info=False;" Set objCon = CreateObject("ADODB.Connection") objCon.Open Con SQL = "select " & Fields & " from [" & TableName & "]" & WhereString & ";" Set ADO_Access = CreateObject("ADODB.Recordset") ADO_Access.Open SQL, objCon, 3, 4, 1 End If Exit Function ErrorHandler: Set ADO_Access = Nothing End Function

Beliebteste Forumthreads (12 Monate)

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread