Viele Importe aus Access erzeugen
16.10.2007 13:06:00
Mike
ich bräuchte eure Hilfe.
Für eine Analyse und Gegenüberstellung will ich Daten aus verschiedenen Access-Datenbaken in Excel importieren.
Die Abfrage der Daten ist immer gleich, jedoch sind es zig verschiedene Datenbanken.
Über eine Tabelle lese ich den Datenbankpfad aus und übergib ihn an das Makro getAccessdata. Den Namen für die Verbindung überschreibe zähle ich automatisch hoch.
Mein Problem, er stellt in jeder Zeile immer nur die Verbindung zur ersten Datenbank her. Wenn ich später die Abfragen manuell auf die anderen Datenbanken umswitche stimmen sie.
Könnt ihr mir helfen? Gestartet wird alles über das Makro-Technik.
Danke
Mike René
Sub getAccessData(Befehl As String, dateiname As String, abfragename As String) 'As Double
With ActiveSheet.QueryTables.Add(Connection:=Array( _
"OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=U:\ _
DOKUMENT\Projekt\OnlineFragebogen\Rohdaten\Buchhalter0" _
, _
"7.MDB;Mode=Share Deny Write;Extended Properties="""";Jet OLEDB:System database="""";Jet _
_
_
OLEDB:Registry Path="""";Jet OLEDB:Database Pa" _
, _
"ssword="""";Jet OLEDB:Engine Type=5;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global _
_
_
Partial Bulk Ops=2;Jet OLEDB:Global Bulk Tr" _
, _
"ansactions=1;Jet OLEDB:New Database Password="""";Jet OLEDB:Create System Database=False; _
_
_
Jet OLEDB:Encrypt Database=False;Jet OLED" _
, _
"B:Don't Copy Locale on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet _
_
_
OLEDB:SFP=False" _
), Destination:=ActiveCell)
.CommandType = xlCmdSql
.CommandText = Befehl
.FieldNames = False
.RowNumbers = False
.FillAdjacentFormulas = False
.Name = abfragename
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.SourceDataFile = dateiname
.Refresh BackgroundQuery:=True
End With
End Sub
Sub technik()
Dim datei As String
For i = 5 To 45
'MsgBox datei
Cells(i, 3).Activate
datei = Range("a1").Value2 & Cells(i, 2).Value2
getAccessData Range("c1").Value2, datei, "T" & i
Next
End Sub