Wenn Datei offen, dann save and close
18.05.2021 07:55:45
Peter
ich suche einen Ansatz wie ich folgendes Problem lösen kann.
In der Datei 1 lasse ich Daten via Power Query einlesen, diese aufbereiten und in einer Pivottabelle anzeigen.
Dafür muß ich unter anderem eine Datei 2 aus einer Datenbank via export als .csv Datei exportieren.
Diese Datei 2 öffnet sich, wird immer im gleichen Pfad abgespeichert und wird danach automatisch wieder geschlossen.
Danach wird Datei 1 aktualisiert via "Refreshall".
In meinem Code, der noch unten eingefügt wird, prüfe ich sekündlich, ob die Datei geöffnet ist. Wenn das der Fall ist, läuft das Makro durch (speichern und schließen).
Das führt jedoch dazu, daß permanent andere geöffnete Excel Dateien überlagert werden, da die Prüfung und der Refresh ständig durchgeführt wird.
Ich suche nun eine Möglichkeit, wie eine Aktualisierung nur dann stattfinden kann, wenn die Datei tatsächlich geöffnet ist. Habt Ihr dafür evtl. eine Idee?
Hier der/die Codes:
1. Diese Arbeitsmappe:
Private Sub Workbook_Open()
Call IntervallDaten
Call IntervallClose
End Sub
Sub IntervallDaten()
Dim NextTime As Date
NextTime = Now + TimeValue("00:00:10")
Application.OnTime NextTime, "IntervallDaten"
ThisWorkbook.RefreshAll
End Sub Sub IntervallClose()
Dim NextTime As Date
NextTime = Now + TimeValue("00:00:01")
Application.OnTime NextTime, "IntervallClose"
Call DateiOffen
End Sub 3. Modul 2
Sub DateiOffen()
Dim wkbMappe As Workbook
On Error Resume Next
Set wkbMappe = Workbooks("Datei2.csv")
On Error GoTo 0
Application.DisplayAlerts = False
If Not wkbMappe Is Nothing Then wkbMappe.SaveAs FileName:="Y:\Order\Unterordner1\Unterordner2\Datei2.csv"
If Not wkbMappe Is Nothing Then wkbMappe.Close
Application.DisplayAlerts = True
End Sub 4. Pivotaktualisierung (für das Problem vermutlich nicht relevant. Der Vollständigkeithalber jedoch mal mit dabei)
Tabelle2 der Arbeitsmappe
Private Sub Worksheet_Change(ByVal Target As Range)
Set Target = Intersect(Target, Range("b2:b500"))
If Target Is Nothing Then Exit Sub
Dim pc As PivotCache
For Each pc In ActiveWorkbook.PivotCaches
pc.Refresh
Next
End Sub
Viele Grüße
Peter