Ordnerauswahl aus Dialogfenster

Sub DateienAktualisieren() strPath = "C:\Stempelzeiten\2020\07_Juli\" strExt = "*.xlsx" 'Dateiextension ggf. anpassen Dim strFile As String If strPath = "" Then Exit Sub Else strFile = Dir(strPath & strExt) Do While Len(strFile) > 0 Workbooks.Open Filename:=strPath & strFile ActiveWorkbook.UpdateLink Name:=ActiveWorkbook.LinkSources 'Verkn?pfungen _ aktualisieren ActiveWorkbook.Save Workbooks(strFile).Close strFile = Dir() Loop End If End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Function GetPfad() As String Dim objFileDialog As FileDialog Dim SItem As Variant Set objFileDialog = Application.FileDialog(msoFileDialogFolderPicker) With objFileDialog .AllowMultiSelect = False .Title = "Bitte Ordner wählen" .InitialFileName = "C:\Stempelzeiten\2020\" .InitialView = msoFileDialogViewDetails .Show If .SelectedItems.Count > 0 Then GetPfad = .SelectedItems(1) & "\" Else GetPfad = "" End If End With Set objFileDialog = Nothing End Function Sub DateienAktualisieren() Dim strFile As String strPath = GetPfad If strPath = "" Then Exit Sub strExt = "*.xlsx" 'Dateiextension ggf. anpassen strFile = Dir(strPath & strExt) Do While Len(strFile) > 0 Workbooks.Open Filename:=strPath & strFile ActiveWorkbook.UpdateLink Name:=ActiveWorkbook.LinkSources 'aktualisieren ActiveWorkbook.Save Workbooks(strFile).Close strFile = Dir() Loop End Sub

Hallo
Ich sehe zwei Möglichkeiten:
a) Ändere in DateienAktualisieren() die Zeile strExt = "*.xlsx" auf


strExt = Application.InputBox("FileExtension: ", "Eingabe der Filetype", "*.xlsx", Type:=2)

b) Mach es ganz anders. Mit dem Filepicker Dialog kannst Du Dir die Dateien auswählen, die Du bearbeiten möchtest. Es sind schon Filter eingestellt. Wenn Du alle Dateien auswählen möchstest, eine beliebige Datei (kein Verzeichnis) anwählen und dann CTRL-A (alle Auswählen). Es werden zwar auch die Unterordner markiert aber es werden nur die Files übernommen


Sub GetFiles()
Dim objFileDialog As FileDialog
Dim SItem As Variant
Set objFileDialog = Application.FileDialog(msoFileDialogFilePicker)
With objFileDialog
.AllowMultiSelect = True
.Title = "Bitte Files wählen"
.InitialFileName = "C:\Stempelzeiten\2020\"
.InitialView = msoFileDialogViewDetails
.Filters.Clear
.Filters.Add "XLS", "*.xls", 1
.Filters.Add "XLSX", "*.xlsx", 2
.Filters.Add "XLSM", "*.xlsm", 3
.Filters.Add "EXCEL", "*.xls*,*.csv", 4
.Filters.Add "ALL", "*.*", 5
.FilterIndex = 2
If .Show = -1 Then
For Each SItem In .SelectedItems
DateienAktualisieren SItem
Next SItem
End If
End With
Set objFileDialog = Nothing
End Sub
Sub DateienAktualisieren(ByVal meineDatei As String)
Workbooks.Open Filename:=meineDatei
ActiveWorkbook.UpdateLink Name:=ActiveWorkbook.LinkSources   'aktualisieren
ActiveWorkbook.Save
ActiveWorkbook.Close
End Sub

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Ordnerauswahl aus Dialogfenster

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread