AW: ganzer PC auf Datei suchen
10.07.2020 16:48:05
volti
Hallo Eberhard,
hier noch eine Variante.
Hier kannst Du Laufwerke oder Verzeichnisse in einer Variablen festlegen. Alles komplett zu durchsuchen, dauert schon sehr lange. Je nachdem, was Du eigentlich machen möchtest, ist eine gezielte Einschränkung vielleicht auch nicht schlecht:
PS: Wenn die Pfadvorgabe leer bleibt, kannst Du einen Pfad aussuchen...
[+][-]
Option Explicit
Option Compare Text
Dim gsPathFilename As String
Sub FileSearch()
Dim sFilename As String, sPath As String, sArr() As String
Dim i As Integer
sPath = "C:\Users\voltm\Desktop,D:\Pictures" 'Gewünschte Laufwerke, Pfade oder leer lassen
If sPath <> "" Then sArr = Split(sPath, ",")
'Datei incl. Pfad oder Datei und anschließend Start-Pfad abfragen
sFilename = InputBox("Bitte den Dateinamen eingeben!", "Datei suchen und öffnen", sFilename)
If StrPtr(sFilename) = 0 Then Exit Sub 'Abbruch gewählt
If sFilename = "" Then Exit Sub 'Nix eingegeben
gsPathFilename = ""
If Not sFilename Like "*:*\*" And sPath = "" Then 'Kein vollständiger Dateipfad
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show <> 0 Then
gsPathFilename = "" 'Globalen Dateinamen leeren
GetFile .SelectedItems(1), sFilename
End If
End With
Else
For i = 0 To UBound(sArr)
GetFile sArr(i), sFilename
If gsPathFilename <> "" Then Exit For
Next i
End If
If gsPathFilename = "" Then
MsgBox "Es konnte keine entsprechende Datei gefunden werden!", vbCritical, "Dateisuche"
Else
MsgBox "Datei gefunden in" & vbLf & gsPathFilename, vbCritical, "Dateisuche"
End If
End Sub
Sub GetFile(sPathname As String, sSearchFile As String)
Dim oFile As Object, oDir As Object
If gsPathFilename <> "" Then Exit Sub 'Suchbegriff gefunden=>raus
On Error Resume Next
With CreateObject("scripting.filesystemobject").GetFolder(sPathname)
'Ordner durchsuchen
For Each oFile In .Files
If Err = 0 Then
If oFile.Name Like sSearchFile & "*" Then
gsPathFilename = sPathname & "\" & oFile.Name
Exit Sub
End If
End If
Next
'Unterordner durchsuchen
For Each oDir In .Subfolders
GetFile sPathname & "\" & oDir.Name, sSearchFile
Next
End With
End Sub
viele Grüße aus Freigericht
Karl-Heinz