title image


Smiley Hier hab ich Dir was gestrickt
Hi,



das geht so:





Function GetSubFolders(strPath As String, strFileName As String)

' =============================================================================

' Funktion:

' =========

' Gibt alle SubFolders des übergebenen Verzeichnisses in einer Textdatei aus

'

' Eingabeparameter:

' =================

' strPath: Das zu untersuchende Verzeichnis (z.B. "C:\Temp\")

' strFileName: Name der Ausgabedatei (z.B. "C:\Temp\SubFolders.txt")

' =============================================================================

Dim fso As Object

Dim fsoFolder As Object

Dim fsoOutFile As Object

Dim subFolder As Object



On Error GoTo GetSubFoldersErr



If Right(strPath, 1) "\" Then

strPath = strPath & "\"

End If



Set fso = CreateObject("Scripting.FileSystemObject")

Set fsoFolder = fso.GetFolder(strPath)



If fsoFolder.SubFolders.Count > 0 Then

For Each subFolder In fsoFolder.SubFolders

Set fsoOutFile = fso.OpenTextFile(strFileName, ForAppending, True)

fsoOutFile.WriteLine subFolder.Path

fsoOutFile.Close

' Rekursiver Aufruf für ggf. vorhandene SubFolders:

Call GetSubFolders(IIf(Right$(strPath & subFolder.Name, 1) "\", (strPath & subFolder.Name & "\"), (strPath & subFolder.Name)), strFileName)

Next subFolder

End If





GetSubFoldersExit:

Set fsoOutFile = Nothing

Set subFolder = Nothing

Set fsoFolder = Nothing

Set fso = Nothing

Exit Function



GetSubFoldersErr:

If Err.Number = 70 Then ' = "Zugriff verweigert"

Set fsoOutFile = fso.OpenTextFile(strFileName, ForAppending, True)

fsoOutFile.WriteLine strPath & "( !!! " & Err.Description & " !!! )"

fsoOutFile.Close

End If

Resume GetSubFoldersExit



End Function





Aufruf z.B. aus dem Direktfenster:





?GetSubFolders("C:\","C:\Temp\MeineSubFolders.txt")





Greetz,

Eric



Spotlight-Kicktipp gestartet!

Steig ein und trete mit Deinem Bundesliga-Tipp gegen die Besten an! :o)

http://www.kicktipp.de/spotlight/



geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: