Microsoft Excel

Herbers Excel/VBA-Archiv

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

Dateien in Unterverzeichnisse

Betrifft: Dateien in Unterverzeichnisse von: dip
Geschrieben am: 14.10.2014 13:29:35

Hallo 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: Dateien in Unterverzeichnisse von: Peter
Geschrieben am: 14.10.2014 14:32:55

Hallo

Anbei ein kleines Makro, das sämtliche Dateien unterhalb es Pfades ausgiebt (rekursive Funktion).

Option Explicit
Const StartDir = "F:\"
Dim fso As Object


Sub AllFiles()
    Set fso = CreateObject("Scripting.FileSystemObject")
    processfolder (fso.getfolder(StartDir).Path)
    
End Sub

Sub processfolder(FName As String)
    Dim myFolder, mySFolder, myFile As Object
    
    Set myFolder = fso.getfolder(FName)
    For Each mySFolder In myFolder.subfolders
        processfolder (mySFolder.Path)
    Next
    
    For Each myFile In myFolder.Files
        'Debug.Print myFile.Path
        Debug.Print myFile.Name
    Next
    
End Sub



  

Betrifft: AW: Dateien in Unterverzeichnisse von: dip
Geschrieben am: 15.10.2014 16:53:14

Danke für dein Input Peter!

ich müsste jedoch wissen wie das von mir dargestellte Makro angepasst werden müsste, damit alle Dateien in den Unterverzeichnissen auch geöffnet werden können.
Wüsste jemand die Lösung dazu?

Beste Grüsse
Patrick


  

Betrifft: AW: Dateien in Unterverzeichnisse von: Peter
Geschrieben am: 16.10.2014 11:02:46

Hallo

Du musst folgende Procedur anpassen (die MsgBox kannst du auch weglassen, in WorkOnWorkbook würde nun dein Code reinkommen)

Sub processfolder(FName As String)
    Dim myFolder, mySFolder, myFile As Object
    Dim myExtension As String
    
    Set myFolder = fso.getfolder(FName)
    For Each mySFolder In myFolder.subfolders
        processfolder (mySFolder.Path)
    Next
    
    For Each myFile In myFolder.Files
        myExtension = UCase(fso.getextensionname(myFile))
        
        If (myExtension = "XLS") Or (myExtension = "XLSX") Or (myExtension = "XLSM") Then

            If MsgBox("Open File: " & myFile.Path, vbYesNo) = vbYes Then
                WorkOnWorkbook (myFile.Path)
            End If
        End If
    Next
    
End Sub

Sub WorkOnWorkbook(mypath As String)
    Dim Wkb As Workbook
    Set Wkb = Workbooks.Open(mypath)
    '....
    '....
    Set Wkb = Nothing
End Sub



  

Betrifft: AW: Dateien in Unterverzeichnisse von: dip
Geschrieben am: 16.10.2014 15:17:48

Hallo Peter,

Danke für deine Nachricht.
Ich möchte nicht dein Makro anpassen bzw. mir fehlt auch das notwendige knowhow dazu.
Gerne würde ich mein Makro anpassen/erweitern, bzw. ein anderes Makro verwenden, dass 1:1 meines entspricht und zusätzlich alle Dateien im Unterverzeichnis "mitöffnet".

Gibt es eine Lösung?

Grüsse
Patrick


 

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