Microsoft Office Forum [ www.Office-Fragen.de ] >> READONLY <<

Habe jetzt folgenden Code zusammengehackt...

Sub DWDDataPoolHolen()
'
' DWDDataPoolHolen Makro
'

'
Application.ScreenUpdating = False
Application.StatusBar = "Initialisiere DWDDataPool"
   
ThisWorkbook.Worksheets.Add.Name = "DWD Query"

On Error GoTo weiter
   
    Sheets("DWD Query").Select
   
Application.StatusBar = "Setze Zeiger auf " & Sheets("Konfiguration Wind").Range("AX13").Value

    ActiveWorkbook.Queries.Add Name:="DWDDataPool", Formula:= _
        "let" & Chr(13) & "" & Chr(10) & "    Quelle = Access.Database(File.Contents(""C:\HyRE-x\DWD\DWDDataPool.accdb""), [CreateNavigationProperties=true])," & Chr(13) & "" & Chr(10) & "    _DWDDataPool = Quelle{[Schema="""",Item=""DWDDataPool""]}[Data]," & Chr(13) & "" & Chr(10) & "    #""Gefilterte Zeilen"" = Table.SelectRows(_DWDDataPool, each [Index] = " & Sheets("Konfiguration Wind").Range("AX13").Value & ")" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    #""Gefilterte Zeilen"""

    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""DWDDataPool""" _
        , Destination:=Range("$A$1")).QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [DWDDataPool]")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = False
        .ListObject.DisplayName = "DWDDataPool"
        .Refresh BackgroundQuery:=False
    End With
   
weiter:

Application.StatusBar = "Schreibe Import-Maske"
    Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False

Application.StatusBar = "Übergebe Daten an Tabelle"
    Call WerteSetzen_DWDQuery

Application.StatusBar = "Trenne Verbindung"
    Do While ActiveSheet.QueryTables.Count > 0
        ActiveSheet.QueryTables.Item(ActiveSheet.Queries.Count).CancelRefresh
        ActiveSheet.QueryTables.Item(ActiveSheet.Queries.Count).Unlink
    Loop

    Do While ActiveWorkbook.Connections.Count > 0
        ActiveWorkbook.Connections.Item(ActiveWorkbook.Connections.Count).Delete
    Loop

Sheets("DWD Query").Delete

End Sub

Das importieren der Daten funktioniert damit wunderbar. Allerdings nur 1x. Damit das Makro ein zweites mal sauber abläuft, muss ich manuell die Arbeitsmappenabfrage löschen. Meine Versuche, zunächst die queries und anschließend die Connections via VBA zu löschen, werden gnadenlos ignoriert.

Auch mußte ich eine "On error goto"-Krücke einbauen, da das Makro nach Ausführung des Befehls

    With ActiveSheet.ListObjects.Add(....
    ...
    end with

automatisch neu startet.

Ist das en Bug, oder ist der Code so "unsauber", daß VBA quasi abstürzt und deshalb das Makro erneut startet?

Bin für jede Anregung dankbar!

LG

André

Zunächst mal Danke für die schnelle Antwort!

Leider verhält es sich bei Query so, daß die Makros nach der Aufzeichnung nicht laufen. Es kommt zu Fehlermeldungen, auch wenn die Startbedingungen zu 100% identisch sind wie zu dem Zeitpunkt, als die Makroaufzeichnung durchgeführt wurde.

Das aufgezeichnete Makro sieht folgendermaßen aus:

Sub GetDWD()

    Sheets("Kosten und Finanzierung").Select
    Sheets.Add After:=ActiveSheet
    Sheets("Tabelle6").Select
    Sheets("Tabelle6").Name = "DWD Query"


    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array(Array( _
        "ODBC;DBQ=C:\HYRE-X\DWD\DWDDataPool.accdb;DefaultDir=C:\HYRE-X\DWD;Driver={Microsoft Access Driver (*.mdb, *.accdb)};DriverId=25;FIL=" _
        ), Array( _
        "MS Access;MaxBufferSize=2048;MaxScanRows=8;PageTimeout=5;SafeTransactions=0;Threads=3;UserCommitSync=Yes;" _
        )), Destination:=Range("$A$1")).QueryTable
        .CommandType = 0                            ' <----------- HIER KOMMT ES ZUR FEHLERMELDUNG
        .CommandText = Array( _
        "SELECT DWDDataPool.Index, DWDDataPool.WS010m, DWDDataPool.WS020m, DWDDataPool.WS030m, DWDDataPool.WS040m, DWDDataPool.WS050m, DWDDataPool.WS060m, DWDDataPool.WS070m, DWDDataPool.WS080m, DWDDataPool.WS090m, DWDDataPool.WS100m, DWDDataPool.WB10C, DWDDataPool.WB10K, DWDDataPool.WB80C, DWDDataPool.WB80K, DWDDataPool.WKNE" & Chr(13) & "" & Chr(10) & "FROM `C:\HYRE-X\DWD\DWDDataPool.accdb`.DWDDataPool DWDDataPool" & Chr(13) & "" & Chr(10) & "WHERE (DWDDataPo" _
        , "ol.Index=34175512)")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .ListObject.DisplayName = "Tabelle_Abfrage_von_DWD"
        .Refresh BackgroundQuery:=False
    End With
End Sub

Der Schlüsselindex muß zudem aus einem Zellwert (Sheet "Konfiguration Turbinen" Range K17) bedient werden, nicht wie in der Aufzeichnung mit der Konstanten ( "ol.Index=34175512)") )

Habe es jetzt 15x versucht mit dem Makro-Reorder. ohne Erfolg.

Was mache ich falsch?

LG

André