Option Explicit
Sub DriveTypeAndList()
Dim strFindExpr As String
strFindExpr = "\Gesamtausgaben"
Dim colDrv As VBA.Collection
Dim vntDrv As Variant
Set colDrv = New VBA.Collection
For Each vntDrv In CreateObject("Scripting.FileSystemObject").Drives
If vntDrv.IsReady Then Call colDrv.Add(vntDrv.RootFolder.Path)
Next
Dim strCmd As String
Dim strResult As String
Debug.Print "[RESULTS]"
For Each vntDrv In colDrv
strCmd = "dir ""$FOLDER"" /A:D /B /S | findstr /I /E ""$FINDEXPR"""
strCmd = Replace$(strCmd, "$FOLDER", CStr(vntDrv), Compare:=vbBinaryCompare)
strCmd = Replace$(strCmd, "$FINDEXPR", strFindExpr, Compare:=vbBinaryCompare)
With CreateObject("WScript.Shell")
strResult = .Exec("%comspec% /C " & strCmd).StdOut.ReadAll()
End With
If strResult <> "" Then
Debug.Print " * '"; MyTrim(strResult); "'"
End If
Next
End Sub
Private Function MyTrim(Expr As String) As String
With CreateObject("VBScript.RegExp")
.MultiLine = True
.Pattern = "^\s*(.*?)\s*$"
MyTrim = .Replace(Expr, "$1")
End With
End Function