ganzer PC auf Datei suchen

Eberhard · 2020-07-10T13:18:19+00:00

Guten Tag Vielleicht finde ich auf diesem Weg eine Lösung die Funktioniert! Mein PC arbeitet mit 64 Bit. Nun möchte ich über ein Eingabefeld (Textfeld) einen Datei Name eingeben. Anschließend soll der der ganze PC sowie alle vorhandene Laufwerke durchsucht werden. Wurde die Datei gefunden, sollte der Pfad wo sich die Datei befindet in einer msgBox anzeigen. Vielleicht hat mir da jemand eine Lösung für 64 Bit. Vielen Dank. Gruss Daniel

Hi
hier mal ein Beispielcode, der alle Laufwerke, die über einen einzelnen Laufwerksbuchstaben ansprechbar sind, und alle Verzeichnisse durchsucht.
Das ist jetzt aber nicht das schnellste und könnte etwas dauern.
im Select Case-Teil kannst du bestimmte Verzeichnisse von der Suche ausnehmen (z.B. das Windows-Verzeichnis mit sehr vielen Dateien), wenn dort der Suchbegriff nicht vorkommen kann.

Sub test()
Dim Suchbegriff As String
Suchbegriff = "180"
Dim L As Long
Dim LW As String
Dim Verzeichnisse
Dim V As Long
Dim Erg As String
Dim Dat As String
Dim Datei As String
Suchbegriff = "*" & LCase(Suchbegriff) & "*"
For L = Asc("C") To Asc("Z")
LW = Chr(L) & ":\"
If Dir(LW & "*", vbDirectory)  "" Then
ReDim Verzeichnisse(0) As String
Verzeichnisse(0) = LW
V = 0
Do Until V > UBound(Verzeichnisse)
Dat = Dir(Verzeichnisse(V) & "*", vbDirectory)
Do Until Dat = ""
If Left(Dat, 1)  "." Then
Datei = Verzeichnisse(V) & Dat
If (GetAttr(Datei) And vbDirectory) = vbDirectory Then
ReDim Preserve Verzeichnisse(UBound(Verzeichnisse) + 1)
Select Case Dat
Case "Windows" 'systemverzeichnisse nicht durchsuchen
Case Else
Verzeichnisse(UBound(Verzeichnisse)) = Datei & "\"
End Select
Else
If LCase(Dat) Like Suchbegriff Then
If InStr(Erg & vbLf, vbLf & Verzeichnisse(V) & vbLf) = 0 Then
Erg = Erg & vbLf & Verzeichnisse(V)
End If
End If
End If
End If
Dat = Dir()
Loop
V = V + 1
Loop
End If
Next
MsgBox Suchbegriff & " gefunden in:" & Erg
End Sub

und wie gesagt ist nicht das schnellste.
Probleme könnte es ggf noch bei geschützten Verzeichnissen geben.
das habe ich noch nicht ausgetestet.
Gruß Daniel

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:&bsol;Users&bsol;voltm&bsol;Desktop,D:&bsol;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 "*:*&bsol;*" 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 & "&bsol;" & oFile.Name
         Exit Sub
      End If
   End If
  Next
  
'Unterordner durchsuchen
  For Each oDir In .Subfolders
      GetFile sPathname & "&bsol;" & oDir.Name, sSearchFile
  Next
 
 End With

End Sub

viele Grüße aus Freigericht
Karl-Heinz

Forumthread: ganzer PC auf Datei suchen

14
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Infobox / Tutorial

PC durchsuchen: So findest Du Dateien mit Excel VBA

Schritt-für-Schritt-Anleitung

Häufige Fehler und Lösungen

Alternative Methoden

Praktische Beispiele

Tipps für Profis

FAQ: Häufige Fragen

Beliebteste Forumthreads (12 Monate)