Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1388to1392
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Alle Dateien in Unterverzeichnisse bearbeiten

Alle Dateien in Unterverzeichnisse bearbeiten
24.10.2014 14:38:10
dip
Guten Tag Allerseits,
Gerne würde ich folgende Problemstellung in das Forum einbringen, in der Hoffnung, jemand kann mir weiterhelfen :-)
Ich habe folgendes Makro:
Option Explicit
Const strPath As String = "C:\Users\xxx\EditBox\" 'Verzeichnis anpassen!!!
Sub Main()
Dim strDateiname As String
Dim wkbBook As Workbook
Dim lngLastRowQ As Long
Dim lngLastRowZ As Long
Dim lngLastCol As Long
Dim intCalc As Integer
Dim i As Long
On Error GoTo Fin
With Application
.ScreenUpdating = False
.AskToUpdateLinks = False
.EnableEvents = False
intCalc = .Calculation
.Calculation = xlCalculationManual
.DisplayAlerts = False
End With
'strDateiname = Dir$(ThisWorkbook.Path & "\*.xls")  Dateityp anpassen!!!
strDateiname = Dir$(strPath & "\*.xlsm")
Do While strDateiname  ""
If strDateiname  ThisWorkbook.Name Then
Set wkbBook = Workbooks.Open(strPath & strDateiname)
' Start des Codes!!!
' Ende des Codes!!!
wkbBook.Close savechanges:=True ' True wenn gespeichert werden soll, False wenn  _
nicht!!!
Set wkbBook = Nothing
End If
strDateiname = Dir$()
Loop
Fin:
Set wkbBook = Nothing
With Application
.ScreenUpdating = True
.AskToUpdateLinks = True
.EnableEvents = True
.Calculation = intCalc
.DisplayAlerts = True
End With
If Err.Number  0 Then MsgBox "Error: " & _
Err.Number & " " & Err.Description
MsgBox "Done!", vbInformation
End Sub

Mit diesem Makro werden alle Dateien in einem bestimmten Verzeichnis geöffnet, das entsprechende Makro ausgeführt (zwischen "Start des Codes" und "Ende des Codes"), und die Datei abgespeichert.
Nun würde ich gerne, dass auch alle Dateien in den Unterordnern in diesem Verzeichnis geöffnet, bearbeitet und abgespeichert werden.
Wie müsste das Makro geändert/ergänzt werden, damit auch alle Dateien in den Unterverzeichnissen mitberücksichtigt werden?
Ich bin für jeden Tipp/Hilfe sehr dankbar!
Beste Grüsse
Patrick

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Alle Dateien in Unterverzeichnisse bearbeiten
25.10.2014 01:15:32
Uwe
Hallo Patrick,
vielleicht so:

Option Explicit
Const strPath As String = "C:\Users\xxx\EditBox" 'Verzeichnis anpassen!!!
Dim strDir() As String
Dim Zeile As Long
Sub Main()
Dim strDateiname As String
Dim wkbBook As Workbook
Dim lngLastRowQ As Long
Dim lngLastRowZ As Long
Dim lngLastCol As Long
Dim intCalc As Integer
Dim i As Long
On Error GoTo Fin
With Application
.ScreenUpdating = False
.AskToUpdateLinks = False
.EnableEvents = False
intCalc = .Calculation
.Calculation = xlCalculationManual
.DisplayAlerts = False
End With
'strDateiname = Dir$(ThisWorkbook.Path & "\*.xls")  Dateityp anpassen!!!
Tree strPath, "*.xls", True
For Zeile = 1 To UBound(strDir)
Set wkbBook = Workbooks.Open(strDir(Zeile))
' Start des Codes!!!
' Ende des Codes!!!
wkbBook.Close savechanges:=True ' True wenn gespeichert werden soll, False wenn nicht!!!
Set wkbBook = Nothing
Next Zeile
Fin:
Set wkbBook = Nothing
With Application
.ScreenUpdating = True
.AskToUpdateLinks = True
.EnableEvents = True
.Calculation = intCalc
.DisplayAlerts = True
End With
If Err.Number  0 Then
MsgBox "Error: " & Err.Number & " " & Err.Description
End If
MsgBox "Done!", vbInformation
End Sub
'________________________________________________________________________
'Code von Bernd (bst)
'http://www.online-excel.de/fom/fo_read.php?f=3&bzh=121&h=120#a123x
Sub Tree(actdir As String, filename As String, showfiles As Boolean)
Dim fname
Dim i As Integer, j As Integer
Dim subdirs() As String
Call ShowDir(actdir, filename, showfiles)
i = 0
fname = Dir(actdir & "\*.*", vbDirectory)
While fname  ""
If fname  "." And fname  ".." And (GetAttr(actdir & "\" & fname) And vbDirectory) =  _
vbDirectory Then
i = i + 1
ReDim Preserve subdirs(i)
subdirs(i) = actdir & "\" & fname
End If
fname = Dir
Wend
For j = 1 To i
Call Tree(subdirs(j), filename, showfiles)
Next
ReDim subdirs(0)
End Sub
Private Sub ShowDir(actdir As String, filename As String, showfiles As Boolean)
Dim fname
If showfiles Then
fname = Dir(actdir & "\" & filename)
While fname  ""
ReDim Preserve strDir(1 To Zeile)
strDir(Zeile) = actdir & "\" & fname
'Cells(Zeile, 1).Value = actdir & "\" & fname
Zeile = Zeile + 1
fname = Dir
Wend
Else
ReDim Preserve strDir(1 To Zeile)
strDir(Zeile) = actdir & "\" & fname
'Cells(Zeile, 1).Value = actdir
Zeile = Zeile + 1
End If
End Sub
Gruß Uwe

Anzeige
AW: Alle Dateien in Unterverzeichnisse bearbeiten
27.10.2014 17:01:31
dip
Hallo Uwe,
Vielen Dank für Deinen Input!
Leider funktioniert es nicht...
Beim Ausführen erhalte ich folgende Fehlermeldung: Error: 9 Index ausserhalb des gültigen Bereiches.
Diese Fehlermeldung erscheint gleich am Anfang, es wird überhaupt keine Datei zuerst geöffnet.
Mir ist aufgefallen, dass in deinem Input steht: "*.xls"
Ich arbeite aber mit xlsm Dateien. Ich habe dies natürlich im Code angepasst, "*.xlsm", jedoch habe ich auch so die gleiche Fehlermeldung erhalten.
Woran könnte es liegen?
Grüsse
Patrick

AW: Alle Dateien in Unterverzeichnisse bearbeiten
28.10.2014 10:19:26
Uwe
Hallo Patrick,
füge vor der Zeile

Tree strPath, "*.xls", True

eine Zeile mit

Zeile = 1
ein.
Gruß Uwe

Anzeige
AW: Alle Dateien in Unterverzeichnisse bearbeiten
28.10.2014 11:20:10
dip
Vielen Herzlichen Danke Uwe!
Es funktioniert wie gehabt :-)
Nochmals Danke für Deine Hilfe und einen schönen Tag wünsche ich Dir!
Beste Grüsse
Patrick

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige