Verzeichnis und Unterordner nach Word-Dokumenten und Suchbegriff "Test" durchsuchen und auflisten

Hallo

ich hoffe, Ihr könnt mir bei einem Problem weiterhelfen:

Ich möchte alle Ordner und Unterordner des Verzeichnisses C:\VBA
nach folgenden Kriterien durchsuchen:

- Word-Dateien
- der Begriff "Test" soll im Dateinamen enthalten sein

Aufgelistet werden soll der komplette Pfad inkl. Dateinamen in:
C:\VBA\Test.xlsm in "Tabelle 1"

Vielen Dank

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 475240

Url: https://administrator.de/forum/verzeichnis-und-unterordner-nach-word-dokumenten-und-suchbegriff-test-durchsuchen-und-auflisten-475240.html

Ausgedruckt am: 22.12.2024 um 18:12 Uhr

4 Kommentare

Neuester Kommentar

Get-ChildItem "C:\VBA\*" -File -Include *.docx,*.doc,*.docm,*.dot,*.dotx,*.dotm -Recurse | ?{$_.Basename -like '*test*'} | select Fullname | export-csv 'C:\VBA\ergebnis.csv' -Delimiter ";" -Encoding UTF8 -NoTypeinformation  

Hallo routerboard,

danke für deine Antwort.
Ich möchte es aber lieber ganz normal mit einem VBA Marko lösen,
weil ich mich mit Shell nicht auskenne und später das Makro noch erweitern will.

Außerdem hatte ich wohl vergessen zu erwähnen,
dass die Ergebnisse aufgelistet werden sollen in:
C:\VBA\Test.xlsm in "Tabelle 1"

Habe meine Anfrage oben noch einmal etwas verständlicher gemacht.

Gruß

Naja dann hätte man das in der Kategorie VBA platzieren sollen.
Einfach mal die Suchfunktion benutzen, Funktionen zum rekursiven Durchsuchen finde ich hier wie Sand am Meer...
z.B. hier
VBScript erweitern für Subfolder
Extension anpassen mit InStr zus. im Dateinamen per IF Abfrage suchen, fertsch ist der Salat. Dafür braucht man ehrlich gesagt keinen Forenthread...

set objFS = CreateObject("Scripting.FilesystemObject")  

parseFolders objFS.GetFolder("c:\vba"),True  

Function parseFolders(strFldr,boolRecursion)
	for each myFile in strFldr.Files
		If LCase(objFS.GetExtensionName(myFile.Name)) = "docx" and InStr(1,myFile.Name,"test",1) > 0 Then  
                    Sheets(1).Cells(Rows.Count,"A").End(xlUp).Offset(1,0).Value = myFile.Path  
		End If
	Next
	If boolRecursion Then
		For Each subFolder in strFldr.SubFolders
			parseFolders subFolder, True
		Next
	End If
End Function

Hallo routerboard,
nochmal danke für die Hilfe.
Ich habe jetzt mal im Internet recherchiert und meine Anliegen wie folgt gelöst.

Private Sub CommandButton1_Click()
Dim colFiles As New Collection
Dim i As Long
listFilesInDir "C:\VBA", "*.do" & "*", colFiles, True 'alle Word-Dateiformate  
If colFiles.Count > 0 Then
For i = 1 To colFiles.Count
If InStr(1, colFiles(i), "Test", 1) > 0 Then  
Sheets(1).Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Value = colFiles(i) 'myFile.Path  
End If
Next i
End If
End Sub

Private Sub listFilesInDir(sStartPath As String, sPattern As String, colFullNames As Collection, Optional bInSubDirs As Boolean)
On Error Resume Next
Dim sTemp As String, sRepeat As String
If Right(sStartPath, 1) <> "\" Then sStartPath = sStartPath & "\"  
sTemp = Dir(sStartPath & sPattern)
Do While Len(sTemp)
If sTemp <> "." And sTemp <> ".." Then  
If (GetAttr(sStartPath & sTemp) And vbDirectory) <> vbDirectory Then               '  
colFullNames.Add sStartPath & sTemp
End If
End If
sTemp = Dir()
Loop
If bInSubDirs = True Then
sTemp = Dir(sStartPath, vbDirectory)
Do While Len(sTemp)
If (sTemp <> ".") And (sTemp <> "..") Then  
If (GetAttr(sStartPath & sTemp) And vbDirectory) = vbDirectory Then
listFilesInDir sStartPath & sTemp, sPattern, colFullNames, bInSubDirs
sRepeat = Dir(sStartPath, vbDirectory)
Do While sRepeat <> sTemp
sRepeat = Dir()
Loop
End If
End If
sTemp = Dir()
Loop
End If
On Error GoTo 0
End Sub