19.07.2012

Alle Dateien eines Ordners - Optional mit Unterordner

Frage: Kann mir mal jemand ein Grundgerüst an die Hand geben, mit dem alle Dateien eines Ordners (optional mit Unterordner) berücksichtigt werden.

Option Explicit
' Suchmuster gegebenenfalls anpassen 
Const strEX As String = "*.xls*"
'-------------------------------------------------------------------------- 
' Module    : Module1 
' Procedure : Files_Read 
' Author    : Case (Ralf Stolzenburg) 
' Date      : 15.10.2012 
' Purpose   : Alle Dateien eines Ordners - Optional mit Unterordner... 
'-------------------------------------------------------------------------- 
Public Sub Files_Read()
    Dim stCalc As Integer
    Dim strDir As String
    Dim objFSO As Object
    Dim objDir As Object
    On Error GoTo Fin
    With Application
        .ScreenUpdating = False
        .AskToUpdateLinks = False
        .EnableEvents = False
        stCalc = .Calculation
        .Calculation = xlCalculationManual
        .DisplayAlerts = False
    End With
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    ' Datei im gleichen Ordner wie Auswertungsdateien 
    ' strDir = ThisWorkbook.Path & "\" 
    ' Fester Ordner vorgegeben 
    strDir = "C:\Temp\Test\"
    strDir = IIf(Right(strDir, 1) <> "\", strDir & "\", strDir)
    Set objDir = objFSO.getfolder(strDir)
    'dirInfo objDir, strEX, True ' Mit Unterordner 
    dirInfo objDir, strEX ' Ohne Unterordner 
Fin:
    With Application
        ' Bei Bedarf 
        '.Goto (ThisWorkbook.Worksheets(1).Range("A1")), True 
        .ScreenUpdating = True
        .AskToUpdateLinks = True
        .EnableEvents = True
        .Calculation = stCalc
        .DisplayAlerts = True
    End With
    Set objDir = Nothing
    Set objFSO = Nothing
End Sub
'-------------------------------------------------------------------------- 
' Module    : Module1 
' Procedure : dirInfo 
' Author    : Case (Ralf Stolzenburg) 
' Date      : 15.10.2012 
' Purpose   : Rekursive Funktion alle Dateien... 
'-------------------------------------------------------------------------- 
Public Sub dirInfo(ByVal objCurrentDir As Object, ByVal strName As String, _
    Optional ByVal blnTMP As Boolean = False)
    Dim varTMP As Variant
    For Each varTMP In objCurrentDir.Files
        If varTMP.Name Like strName Then
            If varTMP.Name <> ThisWorkbook.Name Then
                If Left(varTMP.Name, 1) <> "~" Then
                    ' Hier jetzt der Code um mit der Datei etwas zu machen 
                    ' z. B. Öffnen, etwas auslesen oder was auch immer... 
                    ' Im folgenden werden nur ein paar Informationen 
                    ' im Direktfenster (VBE - STRG+G) ausgegeben 
                    ' Diese Zeilen mit Debug.Print können natürlich 
                    ' gelöscht bzw. auskommentiert werden 
                    Debug.Print "Pfad: " & varTMP.ParentFolder.Path
                    Debug.Print "Pfad & Datei: " & varTMP.Path
                    Debug.Print "Name: " & varTMP.Name
                    Debug.Print "Erstelldatum: " & varTMP.DateCreated
                    Debug.Print "Letzter Zugriff: " & varTMP.DateLastAccessed
                    Debug.Print "Letzte Änderung: " & varTMP.DateLastModified
                    Debug.Print "Größe in Byte: " & varTMP.Size
                    Debug.Print "Type: " & varTMP.Type
                    Debug.Print "Anzahl ALLE: " & varTMP.ParentFolder.Files.Count
                    Debug.Print vbCrLf
                End If
            End If
        End If
    Next varTMP
    If blnTMP = True Then
        For Each varTMP In objCurrentDir.SubFolders
            dirInfo varTMP, strName, blnTMP
        Next varTMP
    End If
End Sub

Formeln auf einer UserForm in einer TextBox darstellen...

Formeln auf einer UserForm in einer TextBox anzeigen. Z. B. "Formula", "FormulaLocal"... und wie muss die Formel in VBA ...