spfad mit Variable über alle Unterordner

Forumthread: spfad mit Variable über alle Unterordner

28.07.2022 15:15:24

Andl

Hallo Zusammen,
ich hoffe Ihr könnt mit helfen: Ich habe ein Makro, welches alle XLS Dateien innerhalb eines Ordners in XLSX Dateien umwandelt und anschließend die XLS Dateien löscht.
Nun möchte ich dieses Makro insoweit abändern, dass auch alle Unterordner miteinbezogen werden, so dass ich innerhalb eines jeden Ordners nur noch XLSX Dateien am Ende habe.
vielen Dank für euren Input.
Sub XLSInXLSxUmwandeln()
Dim oSourceBook As Object
Dim spfad As String
Dim sDatei As String
Application.ScreenUpdating = False 'Das "Flackern" ausstellen
'Schritt 1: Schleife über alle Word Dateien in einem Verzeichnis
spfad = "W:\Faktura\Test\XLSinXLSxumwandeln\*"
sDatei = Dir(CStr(spfad & "*.xls")) 'Alle *.xls Dateien
Do While sDatei ""
'Schritt 2: öffnen der Datei und Datenübertragung
Set oSourceBook = Workbook.Open(spfad & sDatei, False, True) 'nur lesend öffnen
'Schritt 3: Datei speichern und wieder zu machen und nächste Schleifenrunde
Application.DisplayAlerts = False
'Speichern im DOCX Format
oSourceBook.SaveAs FileName:=CStr(spfad & sDatei & "x"), FileFormat:=xlsOpenXMLWorkbook
oSourceBook.Close False
Application.DisplayAlerts = True
'Nächste Datei
sDatei = Dir()
Loop
Application.ScreenUpdating = True 'Das Bildschirm-Aktualisieren wieder einschalten
'Variablen aufräumen
Set oSourceBook = Nothing
End Sub


Private Sub KillEmAll()
'löscht alle .doc im Verzeichnis
Const spfad As String = "W:\Faktura\Test\XLSinXLSxumwandeln\*"
Kill spfad & "*.xls"
End Sub

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: spfad mit Variable über alle Unterordner

28.07.2022 16:19:22

Rudi
AW: spfad mit Variable über alle Unterordner

28.07.2022 16:37:52

Daniel

AW: spfad mit Variable über alle Unterordner

28.07.2022 16:19:22

Rudi

Hallo,
was, wenn die .xls Makros enthalten? Oder kannst du das ausschließen?


Option Explicit
Dim FSO As Object
Sub DateiListe()
Dim oFolder As Object
Dim strFolder As String
Dim i As Integer, j As Integer
Application.ScreenUpdating = False
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Ordner wählen"
.AllowMultiSelect = False
If .Show = -1 Then
strFolder = .SelectedItems(1)
End If
End With
If strFolder = "" Then Exit Sub
Set FSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = FSO.GetFolder(strFolder)
prcFiles oFolder
prcSubFolders oFolder
End Sub
Sub prcFiles(oFolder)
Dim oFile As Object, sEXT As String
Dim wkb As Workbook
For Each oFile In oFolder.Files
sEXT = FSO.getextensionname(oFile)
Select Case LCase(sEXT)
Case "xls"
Set wkb = Workbooks.Open(oFile)
wkb.SaveAs Left(wkb.FullName, Len(wkb.FullName) - 4), xlOpenXMLWorkbook
wkb.Close
Kill oFile  'löscht die *.xls
End Select
Next
End Sub
Sub prcSubFolders(oFolder)
Dim oSubFolder As Object
For Each oSubFolder In oFolder.SubFolders
prcFiles oSubFolder
prcSubFolders oSubFolder
Next
End Sub

Gruß
Rudi

AW: spfad mit Variable über alle Unterordner

28.07.2022 16:37:52

Daniel

Hi
Sammel dir die Ordner und Unterordner in einem Array:


Sub AlleDateien()
Dim Ordner()
Dim Datei
Dim Ord As Long
Dim wb As Workbook
ReDim Ordner(0)
Ordner(0) = "C:\Daten\"
Ord = 0
Do Until Ord > UBound(Ordner)
Application.StatusBar = Ordner(Ord)
Datei = Dir(Ordner(Ord) & "*", vbDirectory)
Do Until Datei = ""
If Datei Like ".*" Then
Else
If (GetAttr(Ordner(Ord) & Datei) And vbDirectory) = vbDirectory Then
ReDim Preserve Ordner(UBound(Ordner) + 1)
Ordner(UBound(Ordner)) = Ordner(Ord) & Datei & "\"
Else
If Datei Like "*.xls" Then
Set wb = Workbooks.Open(Ordner(Ord) & Datei)
wb.SaveAs Ordner(Ord) & Replace(Datei, ".xls", ""), xlOpenXMLWorkbook
wb.Close
Kill Ordner(Ord) & Datei
End If
End If
End If
Datei = Dir
Loop
Ord = Ord + 1
Loop
Application.StatusBar = False
End Sub

Beliebteste Forumthreads (12 Monate)

spfad mit Variable über alle Unterordner

Forumthread: spfad mit Variable über alle Unterordner

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread