Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Alle Dateien in Unterverzeichnisse bearbeiten

Betrifft: Alle Dateien in Unterverzeichnisse bearbeiten von: dip
Geschrieben am: 24.10.2014 14:38:10

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

  

Betrifft: AW: Alle Dateien in Unterverzeichnisse bearbeiten von: Uwe Küstner
Geschrieben am: 25.10.2014 01:15:32

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


  

Betrifft: AW: Alle Dateien in Unterverzeichnisse bearbeiten von: dip
Geschrieben am: 27.10.2014 17:01:31

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


  

Betrifft: AW: Alle Dateien in Unterverzeichnisse bearbeiten von: Uwe Küstner
Geschrieben am: 28.10.2014 10:19:26

Hallo Patrick,

füge vor der Zeile

Tree strPath, "*.xls", True

eine Zeile mit
Zeile = 1
ein.

Gruß Uwe


  

Betrifft: AW: Alle Dateien in Unterverzeichnisse bearbeiten von: dip
Geschrieben am: 28.10.2014 11:20:10

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


 

Beiträge aus den Excel-Beispielen zum Thema "Alle Dateien in Unterverzeichnisse bearbeiten"