Thema Datum  Von Nutzer Rating
Antwort
12.10.2020 08:35:59 Harald
NotSolved
12.10.2020 11:11:29 Mase
***
NotSolved
12.10.2020 12:27:38 Harald
NotSolved
12.10.2020 13:24:59 derominöseNicht_Gast
NotSolved
12.10.2020 14:28:45 Mase
NotSolved
12.10.2020 15:42:31 Gast96901
NotSolved
12.10.2020 15:59:30 Gast46917
NotSolved
12.10.2020 16:04:57 knobloch
NotSolved
12.10.2020 16:08:26 Gast46260
NotSolved
12.10.2020 16:13:03 Harald
NotSolved
12.10.2020 16:23:17 Gast15216
NotSolved
12.10.2020 16:40:44 Knobloch
NotSolved
12.10.2020 17:23:15 Gast4949
NotSolved
12.10.2020 20:01:34 Harald
NotSolved
12.10.2020 20:12:48 Gast97274
Solved
12.10.2020 21:18:28 Mase
NotSolved
Rot Der Vollständigheit halber für alle Laufwerke: ... auch wenn das Vorhaben Irrsinning ist.
 12.10.2020 21:32:08 Gast96901
***
NotSolved
12.10.2020 22:51:44 Nicht_Mase
***
NotSolved
13.10.2020 06:36:02 Mase
NotSolved
13.10.2020 12:11:39 Nicht_Mase
NotSolved

Ansicht des Beitrags:
Von:
Gast96901		 Datum:
12.10.2020 21:32:08		 Views:
685		 Rating:
     
Antwort:
  Ja
Thema:
Der Vollständigheit halber für alle Laufwerke: ... auch wenn das Vorhaben Irrsinning ist.		 
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

 

Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
12.10.2020 08:35:59 Harald
NotSolved
12.10.2020 11:11:29 Mase
***
NotSolved
12.10.2020 12:27:38 Harald
NotSolved
12.10.2020 13:24:59 derominöseNicht_Gast
NotSolved
12.10.2020 14:28:45 Mase
NotSolved
12.10.2020 15:42:31 Gast96901
NotSolved
12.10.2020 15:59:30 Gast46917
NotSolved
12.10.2020 16:04:57 knobloch
NotSolved
12.10.2020 16:08:26 Gast46260
NotSolved
12.10.2020 16:13:03 Harald
NotSolved
12.10.2020 16:23:17 Gast15216
NotSolved
12.10.2020 16:40:44 Knobloch
NotSolved
12.10.2020 17:23:15 Gast4949
NotSolved
12.10.2020 20:01:34 Harald
NotSolved
12.10.2020 20:12:48 Gast97274
Solved
12.10.2020 21:18:28 Mase
NotSolved
Rot Der Vollständigheit halber für alle Laufwerke: ... auch wenn das Vorhaben Irrsinning ist.
 12.10.2020 21:32:08 Gast96901
***
NotSolved
12.10.2020 22:51:44 Nicht_Mase
***
NotSolved
13.10.2020 06:36:02 Mase
NotSolved
13.10.2020 12:11:39 Nicht_Mase
NotSolved