Externer Datenimport von variabler xlsm-Quelle
04.06.2015 12:15:16
variabler
Ziel:
Ich möchte Daten in Excel importieren mittels einer Datenverbindung zu einem speziellen Ordner auf meinem Laptop. In dem Ordner liegen mehrere xlsm-Dateien. Es soll diejenige Datei importiert werden, dessen Ordnerpfad in Sheet1, Zelle C37 angegeben ist (Der Zelleninhalt in C37 und damit der jeweilige Pfad kann sich ändern).
Beispiel:
a) Inhalt Zelle C37: D:\Users\brem\Desktop\MARKT\VBA CSV Stammdaten\Positionsstammdaten\Input (xlms)\1test.xlsm -> Es sollen Daten aus der Datei "1test" in die Excel importiert werden
b) Inhalt Zelle C37: D:\Users\brem\Desktop\MARKT\VBA CSV Stammdaten\Positionsstammdaten\Input (xlms)\2test.xlsm -> Es sollen Daten aus der Datei "2test" in die Excel importiert werden
Problem:
Der VBA Code unten funktioniert zunächst, wenn ich das ganze unvariabel aufnehme, d.h. eine spezielle Datei in dem Ordner auswähle. Wenn ich aber die Dateiauswahl versuche variable zu gestalten mittels strQuelle bekomme ich eine Fehlermeldung (Laufzeitfehler 1004 - Die Abfrage oder das Öffnen der Tabelle konnte nicht ausgeführt werden)
VBA-CODE (Mittels Makro aufnehmen und Online-Recherche zusammengestellt):
Sub Daten_aktualisieren2()
' Pfad Variable definieren
Dim strQuelle As String
strQuelle = Worksheets("Sheet1").Cells(37, 3).Text
' Daten_aktualisieren Makro
Sheets("Sheet2").Select
With ActiveWorkbook.Connections("1test Sheet1$").OLEDBConnection
.BackgroundQuery = True
.CommandText = Array("Sheet1$")
.CommandType = xlCmdTable
.Connection = Array( _
"OLEDB;Provider=Microsoft.ACE.OLEDB.12.0;Password="""";User ID=Admin;Data Source= _
strQuelle;Mode=Share Deny Write;Extended Properties=""HDR=YES;"";Jet OLEDB:System database=""""; _
Jet OLEDB:Re" _
, _
"gistry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Engine Type=37;Jet OLEDB: _
_
Database Locking Mode=0;Jet OLEDB:Global Partia" _
, _
"l 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 OLE" _
, _
"DB:SFP=False;Jet OLEDB:Support Complex Data=False;Jet OLEDB:Bypass UserInfo Validation= _
_
False;Jet OLEDB:Limited DB Caching=False;" _
, "Jet OLEDB:Bypass ChoiceField Validation=False")
.RefreshOnFileOpen = False
.SavePassword = False
.SourceConnectionFile = ""
.SourceDataFile = _
"strQuelle"
.ServerCredentialsMethod = xlCredentialsMethodIntegrated
.AlwaysUseConnectionFile = False
End With
With ActiveWorkbook.Connections("1test Sheet1$")
.Name = "1test Sheet1$"
.Description = ""
End With
ActiveWorkbook.Connections("1test Sheet1$").Refresh
End Sub