Sub Data_IN_laden()
Dim folderPath As String
Dim fileName As String
Dim wb As Workbook
' folder path
folderPath = "\Dies\ist\mein\Pfad\"
' Kontrolle ob ordner existiert
If Dir(folderPath, vbDirectory) = "" Then
MsgBox "Folder does not exist: " & folderPath, vbExclamation
Exit Sub
End If
' Loope durch alle Files im Ordner
fileName = Dir(folderPath & "*.xlsx")
Do While fileName <> ""
' Kontrolle ob file schon geöffnet ist
If IsWorkBookOpen(fileName) Then
' File ist geöffnet, save und schliesse
Set wb = Workbooks(fileName)
wb.Save
wb.Close
Else
' File ist nicht geöffnet, öffne es
Set wb = Workbooks.Open(folderPath & fileName)
ActiveWorkbook.RefreshAll
End If
' Get next file
fileName = Dir
Loop
MsgBox "Alle In-Daten Files geöffnet/gespeichert und geschlossen", vbInformation
End Sub
Function IsWorkBookOpen(fileName As String) As Boolean
Dim wb As Workbook
On Error Resume Next
' Try to set the workbook object to check if it's already open
Set wb = Workbooks(fileName)
On Error GoTo 0
' If the workbook is already open, the object is set successfully
IsWorkBookOpen = Not wb Is Nothing
End Function
Habe die Lösung auf stackverflow gefunden excel - Auto-updating Power Query Connection via VBA - Stack Overflow, aber der Befehl ActiveWorkbook.RefreshAll ist problematisch für grosse Datenmengen. Sie Sprechen zudem von diesem Code:
Sub RefreshQuery()
Dim con As WorkbookConnection
Dim Cname As String
For Each con In ActiveWorkbook.Connections
If Left(con.name, 8) = "Query - " Then
Cname = con.name
With ActiveWorkbook.Connections(Cname).OLEDBConnection
.BackgroundQuery = False 'or true, up to you
.Refresh
End With
End If
Next
End Sub
Ich finde aber mein Query nicht, weiss jemand wo man dies findet?
If Left(con.name, 8) = "Query - " Then?
|