Import aus Access in Excel mit VBA

[MisterMo]

Hallo,

ich versuche derzeit die Aktualisierung eines Excel-Sheets mit VBA zu automatisieren.
Die Daten werden aus einer Access-Tabelle importiert und dann in Excel weiterverarbeitet. Die Weiterverarbeitung funktioniert auch ganz gut, jetzt möchte ich auch noch den Import optimieren. Dafür habe ich mit dem Makro-Rekorder den Import aufgenommen.
Das Problem: Der Code greift jetzt immer auf eine bestimmte Datei in einem bestimmten Verzeichnis zu. Das möchte ich aber ändern, sodass man die Datei selber auswählen kann. Hier ist der Code:

Code:

Dim strPath As String
Dim WindExplorer As Object

Set WindExplorer = Application.FileDialog(msoFileDialogOpen)                                                    
WindExplorer.AllowMultiSelect = False                                                                          
WindExplorer.InitialFileName = "W:\Excel\"
WindExplorer.Show

If WindExplorer <> 0 Then                                                                                
   strPath = Application.FileDialog(msoFileDialogOpen).SelectedItems(1)                                  
   
   If (LCase(strPath) Like LCase("*Bestandsübersicht*")) Then                                  
       
       With Worksheets("Datenbank Import").ListObjects.Add(SourceType:=0, Source:=Array( _
       "OLEDB;Provider=Microsoft.ACE.OLEDB.12.0;Password="""";User ID=Admin;Data Source=strPath;Mode=Sha" _
       , _
       "re Deny Write;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet " _
       , _
       "OLEDB:Engine Type=6;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;J" _
       , _
       "et OLEDB:New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy L" _
       , _
       "ocale on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False;Jet OLEDB:Support Complex Data=False;J" _
       , "et OLEDB:Bypass UserInfo Validation=False"), Destination:=Range("$A$1")). _
       QueryTable
       .CommandType = xlCmdTable
       .CommandText = Array("Bestandsübersicht")
       .RowNumbers = False
       .FillAdjacentFormulas = False
       .PreserveFormatting = True
       .RefreshOnFileOpen = False
       .BackgroundQuery = True
       .RefreshStyle = xlInsertDeleteCells
       .SavePassword = False
       .SaveData = True
       .AdjustColumnWidth = True
       .RefreshPeriod = 0
       .PreserveColumnInfo = True
       .SourceDataFile = strPath
       .ListObject.DisplayName = "Tabelle_Bestandsübersicht.accdb"
       .Refresh BackgroundQuery:=False
   End With

Ich hab nur zweimal das Zielverzeichnis mit der String-Variablen ausgetauscht.
Wenn ich den Code durchlaufen lasse, bekomme ich die Meldung, dass die Datei nicht gefunden wurde obwohl das Verzeichnis stimmt. Habe ich irgendwas übersehen?

Viele Grüße
MisterMo

[Mase]

Hi MisterMo,

das schaut aber nicht nach dem Makrorekorder aus.

[snb]

Ich würde eher eine gelinkte Datei erzetzen als jedesmal einen neue Link erstellen.
z.B

Code:

Sub M_snb()
   With Application.FileDialog(3)
      .InitialFileName = "G:\Access\*.mdb"
      If .Show Then FileCopy .SelectedItems(1), "G:\OF\link.mdb"
   End With
   
    If Sheet1.QueryTables.Count = 1 Then
        Sheet1.QueryTables(1).Refresh
    Else
        With Sheet1.QueryTables.Add("ODBC;DSN=MS Access-database;DBQ=G:\OF\link.mdb", Range("A1"))
            .CommandText = "SELECT  *  FROM `G:\OF\link`.tabel1"
           .Refresh False
        End With
    End If
End Sub

[MisterMo]

@Mase
der Code in dem With-Befehl stammt aus dem Makro-Rekorder und ich versuche den jetzt so anzupassen, dass ein Dialogfenster geöffnet wird und man die zu importierende Access-Tabelle selber auswählen kann..

@snb
vielen Dank schon mal für die Antwort, den Code verstehe ich leider nicht so ganz. Könntest du ihn erklären, damit ich weiß, wie ich ihn anpassen muss?

Viele Grüße
MisterMo