mreske
Goto Top

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

Content-Key: 475240

Url: https://administrator.de/contentid/475240

Printed on: April 18, 2024 at 18:04 o'clock

Mitglied: 140447
140447 Jul 19, 2019 updated at 16:08:03 (UTC)
Goto Top
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  
Member: mreske
mreske Jul 19, 2019 updated at 17:12:07 (UTC)
Goto Top
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ß
Mitglied: 140447
140447 Jul 19, 2019 updated at 17:44:45 (UTC)
Goto Top
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
Member: mreske
mreske Jul 20, 2019 at 11:50:12 (UTC)
Goto Top
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


Danke
Gruß