Windowssuche, Ergebnise in listbox

[perostojkov]

Hallo Excelfreunde,

ich muss oft viele Exceldateien nach bestimtte Wörter drchuchen. Es kalppt gut mit Windows 10

Aus Excel kann ich die  win10 Explorer Suchfunktion so starten:

Code:

Option Explicit
'API declaration for the windows "Search Results" dialog
Private Declare Function ShellSearch& Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hwnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long)

Private Const SW_SHOWNORMAL = 1


Private Sub CommandButton1_Click()
   Const szSDrive As String = "C:\Users\halle4\auftrag\"
   Dim suchwort As String
   'suchwort = Sheets(1).Range("e7").Value 'excel
   'suchwort = InputBox("Search for...", "Look for") 'zb mit excel input
   suchwort = TextBox1.Value 'userform textbox
       If suchwort = "" Then
           MsgBox "es gibt nichts zu suchen"
           Exit Sub
       End If
   ShellSearch 0, "find", szSDrive, "", "", SW_SHOWNORMAL
   Application.Wait (Now + TimeValue("0:00:01"))
   SendKeys suchwort ' dannach ist bei mir die NUM Taste deaktiviert, es gibt Lösungen im Netz
End Sub

Es funktioniert gut, aber...

1. Kann man die Explorer Suchfunktion unsichtbar (ohne windowsfenster) starten und die Egebnise in eine Listbox auflisten?
2. Falls ja, kann man von der Listbox mit Klick auf der Datei die auch öffnen?              ' evtl. mit Button selektierte Datei öffnen
   Je nach Ordner dauert die Suche manchmal etwas länger, hab null erfahrung mit Fortschrittsbalken, würde gerne sie dann auch haben


Ich habe lange im netzt gesucht, einiges ausprobiert, leider sind meine englische und vba kenntnise sehr schlecht. ( ich weiß... deutsch auch )
Hoffe ihr könnt mir wieder helfen

Gruß perostojkov

[schauan]

Hallöchen,

ich würde die Suche so lösen:

Sub DOS_Suche()
strsuche = "dir C:\Test\ /B /S >C:\Test\gefunden.txt"
Shell Environ$("comspec") & " /c " & strsuche, vbHide
End Sub

Du bekommst eine Textdatei, die Du in Excel einlesen und deren Inhalt Du z.B. für Hyperlinks verwenden kannst.

[perostojkov]

Hallo schauan,

leider ist das zu kompliziert für mich.
Danke dass du so schnell geantwortet hast

Gruß perostojkov

[schauan]

Hallöchen,

wenn Du mit API hantierst und längere Codes hast, dachte ich, dass "vba - Kenntnisse schlecht" nur etwas untertrieben war …

Mit meinem Ansatz könntest Du erst mal eine Liste von Dateien erstellen, in denen Du suchen willst. Du könntest die z.B. mit Wildcards auf *.txt einschränken
Im Anschluss kämen zwei weitere Schritte dazu.
1. Einlesen der Textdatei mit den Dateinamen
2. Durchsuchen jeder Datei nach dem Suchwort

Das könnte so aussehen. Die zu durchsuchenden Dateien sollten eventuell noch eingeschränkt werden. Die Treffer sind dann in einer Collection - colFound - kannst DU in der Überwachung anschauen - und diese müsste dann an die Listbox übergeben werden.

Code:

Sub DOS_Suche()
'Variablendeklarationen
Dim retVal$, strSuche$, strLine$
Dim colFiles As New Collection, colFound As New Collection
Dim iCnt&, iFile%
'Suche definieren
strSuche = "dir C:\Test\ /B /S >C:\Test\gefunden.txt"
'DOS-Suche
Shell Environ$("comspec") & " /c " & strSuche, vbHide
'Trefferdatei zuweisen
strSuche = "C:\Test\gefunden.txt"
'freie Filehandler Nr ermitteln
iFile = FreeFile
'Trefferdatei oeffnen
Open strSuche For Input As #iFile
'Datei zeilenweise einlesen
'Hinweis: Funktioniert so nicht bei Binaerfiles!
'Schleife bis Dateiende
Do Until EOF(1)
    'Zeile einlesen
    Line Input #iFile, strLine
    'Zeile einer Collection zuweisen
    colFiles.Add strLine
'Ende Schleife bis Dateiende
Loop
'Trefferdatei schliessen
Close #1
'Suchwort festlegen
strSuche = "Windows"
'Schleife ueber alle gefundenen Dateien
For iCnt = 1 To colFiles.Count
  'Datei komplett einlesen
  retVal = GetText(colFiles(iCnt))
  'Wenn Suchbegriff enthalten, dann
  If InStr(1, retVal, strSuche) > 0 Then
    'Dateiname in Collection uebernehmen
    colFound.Add colFiles(iCnt)
  'Ende Wenn Suchbegriff enthalten, dann
  End If
'Ende Schleife ueber alle gefundenen Dateien
Next
End Sub

Function GetText(sFile As String) As String
'Variablendeklarationen
Dim iFile As Integer, sText As String
'offene Dateien schliessen
Close
'freie Filehandler Nr ermitteln
iFile = FreeFile
'bei Fehler zur Fehlerbehandlung
'Fehlerursache u.a. kein Zugriff auf Datei, Ordner, ...
On Error GoTo errorhandler
'Datei oeffnen
Open sFile For Input As #iFile
'komplette Datei einlesen
sText = Input$(LOF(1), 1)
'offene Dateien schliessen
Close
errorhandler:
'Text uebernehmen
GetText = sText
End Function

[perostojkov]

Hallo, 

ich kann es doch nicht :/
werden auch .xls Dateien durchsucht oder nur .txt ?

auch  mit der Übergabe an die Listbox mache ich alles falsch...

Code:

Dim Item As Variant
For Each Item In colFound
   ListBox1.AddItem Item
Next Item

einiges ausprobiert, verstehe nur noch Bahnhof

[Case]

Hallo, :19:

Du kannst z. B. mit "ADO" auf die "Windows Suche" zugreifen: :21:

ADO - SQL - Windows Suche...

Da gibt es aber Einschränkungen - siehe den Link am Ende.

Besser ist hier die Windows PowerShell. Da bist Du absolut flexibel.

[schauan]

Hallöchen,

das Stückchen code ist eigentlich in Ordnung. Was geht denn nicht? Wo steht denn der Code, in welchem Modul und in welchem Sub?


@case - mit der Powershell würdest Du aber auch nur eine Liste von Dateien erstellen, oder? Der ADO-Link ist auch nicht verkehrt. Allerdings braucht der TE eher eine fertige Lösung und kann das nicht so einfach umsetzen..

[Case]

Hallo André, :19:

mit PoweShell (gestartet über VBA) kannst Du dir das ausgeben lassen, wo immer du willst. Man könnte es auch gleich in Excel schreiben. PowerShell ist da sehr mächtig - und schnell. :21:

Kostet natürlich etwas Einarbeitungszeit.

[perostojkov]

Hallo

ich bin echt zu blöd dafür 

kann BITTE jemnad den userform code erweitern? BITTE BITTE 

[attachment=20241]

[Case]

Hallo, :19:

es gelten die Einschränkungen, auf welche ich im Link oben hingewiesen habe. Es ist getestet und rennt problemlos bei mir durch. :21:


  Explorer_suche.xls (Größe: 58 KB / Downloads: 7)