Verzeichnisse per VBA

Grüezi midanand,
ich suche nach einer Möglichkeit, ein Verzeichnis auf Unterverzeichnisse und Dateien zu überprüfen.
In einem ersten Schritt soll überprüft werden, ob das Verzeichnis überhaupt existiert. (Das habe ich schon)
Im zweiten Schritt, den ich neu einbauen will, soll auf Unterverzeichnisse geprueft werden. Und hier bringt er mir eine Fehlermeldung, wenn kein Unterverzeichnis, sondern nur Dateien da sind.
Ich checke mit
"MyName = Dir(MyPath, vbDirectory)")
Wenn MyName kein Directory ist, soll er weitermachen und steigt mir dann bei
MyName = Dir
mit der Fehlermeldung "Invalid ProcedureCall or Argument" aus.
MyName hat dann (noch) den Wert "."
Wie mache ich das also korrekt?
Danke fuer Eure Hilfe
Gruss
Claus

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Claus,
vielleicht kannst Du hiermit etwas anfangen:
Option Explicit
Private astrDateien() As String
Sub Test()
Dim intI As Integer
sSucheDatei "C:\Temp\"
For intI = LBound(astrDateien()) To UBound(astrDateien())
Debug.Print astrDateien(intI)
Next intI
End Sub


Private Sub sSucheDatei(strPath As String)
Dim intI As Integer
Dim blnDisplayStatusBar As Boolean
Dim blnNotDisplayStatusBar As Boolean
On Error GoTo PROC_ERR
If Dir(strPath, vbDirectory) <> "" Then
blnDisplayStatusBar = Application.DisplayStatusBar
If Err.Number <> 0 Then
Err.Clear
blnNotDisplayStatusBar = True
Else
Application.DisplayStatusBar = True
Application.StatusBar = "Durchsuche """ & strPath & """ ..."
End If
On Error GoTo PROC_ERR
With Application.FileSearch
.NewSearch
.LookIn = strPath
.SearchSubFolders = True
.Filename = "*.*"
.MatchTextExactly = True
.FileType = msoFileTypeAllFiles
.Execute
For intI = 1 To .FoundFiles.Count
ReDim Preserve astrDateien(1 To intI)
astrDateien(intI) = .FoundFiles(intI)
Next
End With
If blnNotDisplayStatusBar = False Then
Application.StatusBar = ""
Application.DisplayStatusBar = blnDisplayStatusBar
End If
End If
PROC_EXIT:
Exit Sub
PROC_ERR:
MsgBox "Fehler #" & Err.Number & vbCrLf & Err.Description, vbExclamation, "

Private Sub sSucheDatei()"
Resume PROC_EXIT
End Sub


Viel Erfolg

Frank.

Private Sub sSucheDatei(strPath As String) Dim intI As Integer On Error GoTo PROC_ERR If Dir(strPath, vbDirectory) <> "" Then With Application.FileSearch .NewSearch .LookIn = strPath .SearchSubFolders = True .Filename = "*.*" .MatchTextExactly = True .FileType = msoFileTypeAllFiles .Execute For intI = 1 To .FoundFiles.Count ReDim Preserve astrDateien(1 To intI) astrDateien(intI) = .FoundFiles(intI) Next End With End If PROC_EXIT: Exit Sub PROC_ERR: MsgBox "Fehler #" & Err.Number & vbCrLf & Err.Description, vbExclamation, " Private Sub sSucheDatei()" Resume PROC_EXIT End Sub Viel Erfolg Frank.

Beliebteste Forumthreads (12 Monate)

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

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread