|
Hallo,
in meinem Spielprojekt, zu dem ich schon den Beitrag Die Methode 'Calculation' für das Object '_Application" ist fehlgeschlagen angelgt habe, geht es darum, dass ich Power Queries in beliebigen Mappen ferngesteuert aktualisieren und in der aufrufenden Mappe protokollieren will. Zur Auswertung der Protokollierung habe ich in der Mappe selbst auch 2 Power Queries angelegt.
Nachdem dies dann alles wie gewüncht funktioniert hatte, kam ich auf die Idee, die ferngesteuerte Aktualisierung über die Aufgabenplanung zu triggern. Ich habe dazu auch schnell ein YouTube-Video (https://www.youtube.com/watch?v=mNvFCE1pjAM) gefunden, in dem die notwendigen Schritte sehr nachvollziebar erläutert werden.
Nachdem ich nun die Erste Hürde umschifft hatte, tauchte sofort die nächte auf. Denn wenn ich am Ende der ferngesteurten Aktualisierung die Queries der durch das VBS-File geöffneten Arbeitsmappe aktualieren will erhalte ich die Fehlermeldung der Titelzeile.
Ich konnte nun zwar auch dieses Problem umschiffen, indem ich die erforderlichen Schritte im Makroablauf vorverlegt habe, aber meine VBA-Kenntnisse sind zu gering, um zu verstehen, warum es and der späteren Stelle nicht mehr funktioniert.
Option Explicit
Sub Aufgabenplanung()
Dim WB_name As String
Call Remote_Refresh_Do("Aus Sub Aufgabenplanung")
' Bei einem Aufruf durch eine VBS-Datei erzeugen die Nachfolgenden Schritte Fehlermeldungen.
' WB_name = ActiveWorkbook.Name
' ActiveWorkbook.Connections("Abfrage - tbl_Log_Queries").Refresh
' MsgBox "Abfrage - tbl_Log_Queries: finished"
' ActiveWorkbook.Connections("Abfrage - tbl_Log_Workbooks").Refresh
' MsgBox "Abfrage - tbl_Log_Workbooks: finished"
' Das sichern des Workbooks wird aus dem VBS-File angestossen.
' Simit ist es auch kein Problem, dass der nachfolgende, kommentierte, Befehl hier auf einen Fehler läuft.
' ActiveWorkbook.Save
' MsgBox "ActiveWorkbook.Save: finished"
End Sub
Sub Remote_Refresh()
Call Remote_Refresh_Do("Aus Sub Remote_Refresh")
End Sub
Sub Remote_Refresh_Do(Aufrufer As String)
Dim wb As Workbook, _
WB_name As String, _
wb_remote As String, _
no_close As String, _
curr_WB_name As String, _
excel_File As Workbook, _
wk_path_wb As String, _
wk_repeats As Integer, _
wk_count As Integer, wk_refreshes As Integer, _
idx As Integer, _
x As Integer, _
Last_Dir As String, Last_WB As String, Curr_Dir As String, Curr_WB As String, _
wb_opened As String, _
wk_now
Dim PQ_start As Double, _
PQ_Ende As Double, _
PQ_Dauer As Double, _
wk_range As String, _
PQ_name As String, PQ_name_pur As String, _
lobj_log As ListObject, _
log_rows As Integer
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
wk_count = Sheets("T1").ListObjects("tbl_remote_refresh").ListRows.Count
log_rows = Sheets("Log").ListObjects("tbl_Log").ListRows.Count
wk_now = DateTime.Now
WB_name = ActiveWorkbook.Name
For idx = 1 To wk_count
With Sheets("T1").ListObjects("tbl_remote_refresh")
If idx = 1 Then
.ListColumns("Start").DataBodyRange.ClearContents
.ListColumns("Ende").DataBodyRange.ClearContents
.ListColumns("Dauer").DataBodyRange.ClearContents
End If
If .ListColumns("Directory").DataBodyRange(idx).Value <> "" Then
Curr_Dir = .ListColumns("Directory").DataBodyRange(idx).Value
End If
If .ListColumns("Workbook").DataBodyRange(idx).Value <> "" Then
Curr_WB = .ListColumns("Workbook").DataBodyRange(idx).Value
End If
If Curr_Dir = "" Then
Curr_Dir = Last_Dir
End If
If Curr_WB = "" Then
Curr_WB = Last_WB
End If
If (Curr_Dir <> Last_Dir Or _
Curr_WB <> Last_WB) And _
wb_opened = "x" Then
wb_opened = ""
Last_Dir = Curr_Dir
Last_WB = Curr_WB
If wk_refreshes > 0 Then
wk_refreshes = 0
If no_close <> "x" Then
wb.Windows(1).Visible = True
wb.Close SaveChanges:=True
Else
wb.Save
End If
Else
If no_close <> "x" Then
wb.Close SaveChanges:=False
End If
End If
End If
Last_Dir = Curr_Dir
Last_WB = Curr_WB
If Curr_Dir <> "" And Curr_WB <> "" And wb_opened = "" Then
For Each excel_File In Workbooks
If excel_File.Name = Curr_WB Then
no_close = "x"
Exit For
End If
Next
wb_remote = Curr_Dir & Curr_WB
On Error GoTo not_opened
Application.DisplayAlerts = False
Set wb = GetObject(wb_remote) 'Auch notwendig, wenn bereits offen
Application.DisplayAlerts = True
wb_opened = "x"
On Error GoTo 0
End If
' Nur wenn ein Workbook geöffnet wurde, wird Refresh = "Ja" berücksichtigt
' In den Abfrageeinstellungen der relevanten Abfragen muss die Option
' "Aktualisierung im Hintergrund zulassen" deaktiviert sein.
If .ListColumns("Refresh").DataBodyRange(idx).Value = "Ja" And wb_opened = "x" Then
wk_refreshes = wk_refreshes + 1
PQ_name = "Abfrage - " & .ListColumns("Query").DataBodyRange(idx).Value
PQ_name_pur = .ListColumns("Query").DataBodyRange(idx).Value
PQ_start = Timer
wb.Connections(PQ_name).Refresh
PQ_Ende = Timer
PQ_Dauer = PQ_Ende - PQ_start
.ListColumns("Start").DataBodyRange(idx).Value = PQ_start / 86400
.ListColumns("Ende").DataBodyRange(idx).Value = PQ_Ende / 86400
.ListColumns("Dauer").DataBodyRange(idx).Value = PQ_Dauer
.ListColumns("Anz. Dauer").DataBodyRange(idx).Value = .ListColumns("Anz. Dauer").DataBodyRange(idx) + 1
.ListColumns("Dauer kum.").DataBodyRange(idx).Value = .ListColumns("Dauer kum.").DataBodyRange(idx) + PQ_Dauer
If .ListColumns("Dauer min.").DataBodyRange(idx).Value = "" Or _
.ListColumns("Dauer min.").DataBodyRange(idx).Value > PQ_Dauer Then
.ListColumns("Dauer min.").DataBodyRange(idx).Value = PQ_Dauer
End If
If .ListColumns("Dauer max.").DataBodyRange(idx).Value = "" Or _
.ListColumns("Dauer max.").DataBodyRange(idx).Value < PQ_Dauer Then
.ListColumns("Dauer max.").DataBodyRange(idx).Value = PQ_Dauer
End If
End If
If .ListColumns("Refresh").DataBodyRange(idx).Value = "Ja" And wb_opened = "x" Then
With Sheets("Log").ListObjects("tbl_Log")
.ListRows.Add
log_rows = log_rows + 1
.ListColumns("Timestamp").DataBodyRange(log_rows).Value = wk_now
.ListColumns("Workbook").DataBodyRange(log_rows).Value = Curr_WB
.ListColumns("Query").DataBodyRange(log_rows).Value = PQ_name_pur
.ListColumns("Start").DataBodyRange(log_rows).Value = PQ_start / 86400
.ListColumns("End").DataBodyRange(log_rows).Value = PQ_Ende / 86400
.ListColumns("Duration").DataBodyRange(log_rows).Value = PQ_Dauer
End With
End If
End With
not_opened:
Application.DisplayAlerts = True
Next
Hier wird bei Ausführung durch das VBS-File das Workbook noch erkannt.
Dim WB_name2 As String
WB_name2 = ActiveWorkbook.Name
If Aufrufer = "Aus Sub Aufgabenplanung" Then
ActiveWorkbook.Connections("Abfrage - tbl_Log_Queries").Refresh
ActiveWorkbook.Connections("Abfrage - tbl_Log_Workbooks").Refresh
End If
If wk_refreshes > 0 Then
If no_close <> "x" Then
wb.Windows(1).Visible = True
wb.Close SaveChanges:=True
Else
' Werden die Änderungen in der geöffneten Mappe gezeigt ???
wb.Save
End If
Else
If no_close <> "x" Then
wb.Close SaveChanges:=False
End If
End If
' Bei einem Aufruf durch eine VBS-Datei erzeugt der nachfolgende Schritt eine Fehlermeldung.
' Application.Calculation = xlCalculationAutomatic
' Deshalb nun
If Aufrufer = "Aus Sub Aufgabenplanung" Then
On Error Resume Next
End If
Application.Calculation = xlCalculationAutomatic
On Error GoTo 0
Hier wird bei Ausführung durch das VBS-File das Workbook nicht mehr erkannt und mit dem Laufzeitfehler 91 quittiert.
' WB_name = ActiveWorkbook.Name
' If Aufrufer = "Aus Sub Aufgabenplanung" Then
' ActiveWorkbook.Connections("Abfrage - tbl_Log_Queries").Refresh
' ActiveWorkbook.Connections("Abfrage - tbl_Log_Workbooks").Refresh
' End If
Application.ScreenUpdating = True
End Sub
Ich würde mich freuen, wenn es mir jemand erklären kann.
Aber da ich ja mittlerweile für beide Probleme einen Workaround habe, werde ich das Projekt auch demnächst im ms-office-forum vorstellen.
|