Filesearch Explorersuche Datei Suchen

Forumthread: Filesearch Explorersuche Datei Suchen

07.04.2020 09:08:34

Dennis

Hallo zusammen,
Ich möchte aus einer Mappe heraus eine Datei Suchen.
Man geht hin und gibt in einem Tabellenblatt eine Artikelnummer an, worauf hin sich die Mappe die Daten aus einer Datenbank heraus zieht. Die Mitarbeiter haben dann die Möglichkeit verschiedene Blätter abzuarbeiten.
Jetzt möchte ich denen aber auch die Option bieten sich div. Unterlagen zu den Produkten anzusehen.
Da es mehr als 2500 PDF´s sind und diese alle mit einer Artikelnummer am anfangen, kam mir die Idee, dies mit der Explorer suche zu verknüpfen.
Ein bisschen recherche im Netz, enthüllte mir, dass sich ab 2007 die Application.Filesearch nicht mehr aufrufen lässt bzw. ab 2010. Dies wäre aber genau die Option welche ich bräuchte.
Gibt es irgendwelche anderen Möglichkeiten, die Artikelnummer aus einer Zelle heraus einzulesen und diese per Knopfdruck im Explorer Suchen zu lassen, so dass er mir die PDF anzeigt, welche die Artikelnummer beinhaltet?
Die Artikelnummer würde in meinem Fall in Zelle "B2" stehen und das Blatt heißt "Personal". Schön wäre es auch, wenn man noch ein Verzeichnis angeben kann um die Suche zu beschleunigen und er nicht mehrere TB vom Server absucht.

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Filesearch Explorersuche Datei Suchen

07.04.2020 09:25:26

Nepumuk

Hallo Dennis,
befinden sich die PDF's alle im selben Ordner? Soll das PDF automatisch geöffnet werden?
Gruß
Nepumuk

AW: Filesearch Explorersuche Datei Suchen

07.04.2020 10:12:17

Dennis

Sie sind in einem Ordner mit 5 Unterordnern.
Öffnen wäre schön, aber kein muss.

AW: Filesearch Explorersuche Datei Suchen

07.04.2020 10:21:52

Dennis

Ordnerstruktur:
Stapelschema\ 6 Ordner ( Archiv, EVE, HAA, NB, PRZ, RK )
Diese 6 Ordner müsste er durchsuchen, weswegen ich ihm als Pfad dann "G:\bla\bla\Stapelschema\" vorgeben wollen würde.
Die Struktur würde ich auch gerne beibehalten, da verschiedene Leute, neue Dateien einstellen.
Wenn ein Artikel weg fällt, macht das jedes Werk für sich. Kommen welche hinzu ebenfalls. So hätte ich das ganze "Dynamisch?".

AW: Filesearch Explorersuche Datei Suchen

07.04.2020 10:27:40

Nepumuk

Hallo Dennis,
in das Modul der Tabelle:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$B$2" Then Call SearchPDF(Target.Text)
End Sub

In ein Standardmodul:

Option Explicit
Option Private Module

Private Declare PtrSafe Function ShellExecuteA Lib "shell32.dll" ( _
    ByVal hwnd As LongPtr, _
    ByVal lpOperation As String, _
    ByVal lpFile As String, _
    ByVal lpParameters As String, _
    ByVal lpDirectory As String, _
    ByVal nShowCmd As Long) As LongPtr

Private Const SW_MAXIMIZE As Long = 3

Public Sub SearchPDF(ByVal pvstrNumber As String)
    Const FOLDER_PATH As String = "G:\Eigene Dateien\Eigene PDF\" 'Pfad des Hauptordners ANPASSEN !!!
    Dim astrFolders() As String, strFilename As String
    Dim ialngFolders As Long
    astrFolders = GetFolders(FOLDER_PATH)
    For ialngFolders = LBound(astrFolders) To UBound(astrFolders)
        strFilename = Dir$(astrFolders(ialngFolders) & "*" & pvstrNumber & "*.pdf")
        If strFilename <> vbNullString Then
            Call ShellExecuteA(0, "OPEN", astrFolders(ialngFolders) & strFilename, _
                vbNullString, vbNullString, SW_MAXIMIZE)
            Exit For
        End If
    Next
End Sub

Private Function GetFolders(ByVal pvstrPath As String) As String()
    Dim astrFolders() As String
    Dim strFolder As String, strPath As String
    Dim ialngIndex1 As Long, ialngIndex2 As Long
    Redim Preserve astrFolders(ialngIndex1)
    astrFolders(ialngIndex1) = pvstrPath
    ialngIndex1 = 1
    ialngIndex2 = 1
    strPath = pvstrPath
    Do
        strFolder = Dir$(PathName:=strPath & "*", Attributes:=vbDirectory)
        Do Until strFolder = vbNullString
            If strFolder <> "." And strFolder <> ".." Then
                If GetAttr(PathName:=strPath & strFolder) And vbDirectory Then
                    Redim Preserve astrFolders(0 To ialngIndex1)
                    astrFolders(ialngIndex1) = strPath & strFolder & "\"
                    ialngIndex1 = ialngIndex1 + 1
                End If
            End If
            strFolder = Dir$
        Loop
        If ialngIndex1 = ialngIndex2 Then Exit Do
        strPath = astrFolders(ialngIndex2)
        ialngIndex2 = ialngIndex2 + 1
    Loop
    GetFolders = astrFolders
End Function

Gruß
Nepumuk

AW: Filesearch Explorersuche Datei Suchen

07.04.2020 10:40:31

Dennis

Hallo Nepumuk,
Erstmal besten Dank für deine schnelle Hilfe.
Habe das ganze jetzt übertragen. Jetzt hab ich nur das Problem, dass ich das ganze nicht gestartet bekomme...
Da es ja "Private Subs" sind kann ich das ja nicht als per Steuerelement starten.
Wenn ich die Artikelnummer händisch in die "B2" eintrage und mit Enter bestätige passiert ebenfalls nichts :/

AW: Filesearch Explorersuche Datei Suchen

07.04.2020 10:48:25

Nepumuk

Hallo Dennis,
kann ich nicht nachvollziehen. Hast du den Ordner angepasst und hast du am Ende des Pfades auch den Backslash drin? Befindet sich das erste Makro auch im Modul der Tabelle in die du die Zelle B2 änderst? Sind Makros aktiviert?
Gruß
Nepumuk

AW: Filesearch Explorersuche Datei Suchen

07.04.2020 10:55:19

Dennis

Hi,
Ja meine anderen Makros funktionieren alle...
Schreib mich sonst mal per Dennis.Niedenzu@gmx.de an =) Denke das ist einfacher.
In Tabelle 15
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$B$2" Then Call SearchPDF(Target.Text)
End Sub

Im Modul "Search"
Option Explicit
Option Private Module
Private Declare PtrSafe Function ShellExecuteA Lib "shell32.dll" ( _
ByVal hwnd As LongPtr, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As LongPtr
Private Const SW_MAXIMIZE As Long = 3

Public Sub SearchPDF(ByVal pvstrNumber As String)
Const FOLDER_PATH As String = "G:\Gesellschaften\******\******\Kommunikation\Dennis *****\ _
BAckup\Stapelschema\" 'Pfad des Hauptordners ANPASSEN !!!
Dim astrFolders() As String, strFilename As String
Dim ialngFolders As Long
astrFolders = GetFolders(FOLDER_PATH)
For ialngFolders = LBound(astrFolders) To UBound(astrFolders)
strFilename = Dir$(astrFolders(ialngFolders) & "*" & pvstrNumber & "*.pdf")
If strFilename  vbNullString Then
Call ShellExecuteA(0, "OPEN", astrFolders(ialngFolders) & strFilename, _
vbNullString, vbNullString, SW_MAXIMIZE)
Exit For
End If
Next
End Sub

Private Function GetFolders(ByVal pvstrPath As String) As String()
Dim astrFolders() As String
Dim strFolder As String, strPath As String
Dim ialngIndex1 As Long, ialngIndex2 As Long
ReDim Preserve astrFolders(ialngIndex1)
astrFolders(ialngIndex1) = pvstrPath
ialngIndex1 = 1
ialngIndex2 = 1
strPath = pvstrPath
Do
strFolder = Dir$(PathName:=strPath & "*", Attributes:=vbDirectory)
Do Until strFolder = vbNullString
If strFolder  "." And strFolder  ".." Then
If GetAttr(PathName:=strPath & strFolder) And vbDirectory Then
ReDim Preserve astrFolders(0 To ialngIndex1)
astrFolders(ialngIndex1) = strPath & strFolder & "\"
ialngIndex1 = ialngIndex1 + 1
End If
End If
strFolder = Dir$
Loop
If ialngIndex1 = ialngIndex2 Then Exit Do
strPath = astrFolders(ialngIndex2)
ialngIndex2 = ialngIndex2 + 1
Loop
GetFolders = astrFolders
End Function

AW: Filesearch Explorersuche Datei Suchen

07.04.2020 11:11:58

Martin

Hallo Dennis,
das Prinzip des Forums ist es nicht nur kostenlose Unterstützung zu erhalten, sondern andere Forenbesucher mit ähnlichen Problemen (z.B. später per Archivsuche) an allen Lösungen teilhaben zu lassen. Es ist unerwünscht (auch für die Helfer) in privaten Kontakt zu treten, wo persönliche Daten (z.B. Email-Adressen) ausgetauscht werden.
Bitte stelle deine Probleme durch eine detaillierte Beschreibung und ggf. mit Screenshots dar. Was du in eine Email schreibst, kannst du auch hier ins Forum schreiben.
Viele Grüße
Martin

AW: Filesearch Explorersuche Datei Suchen

07.04.2020 11:23:02

Dennis

Hallo Lieber Martin,
Das werde ich im Nachgang machen. Leider ist hier nur ein Dateiupload von ein paar wenigen kb möglich. MEine Datei ist aber über 2MB groß, weswegen ich dies per Email gemacht habe.
Ich verstehe und schätze das Forum sehr, nur mir war kein anderer Weg in Sicht... sorry for that =(

AW: Filesearch Explorersuche Datei Suchen

07.04.2020 14:18:19

Dennis

So kommen wir mal zur Auflösung, wie es jetzt bei mir funktioniert....
Ach so. Auch hier noch mal ein herzliches Dankeschön an Nepumuk! Echt Top Typ!
__________________________________________________________________________________________________
In das Tabellenblatt in dem das ganze passiert:
So könnt ihr das ganze per Steuerelement starten, sonst per Abfrage der Zelle, bitte von weiter oben den Code benutzen.
Option Explicit

Public Sub Stapelschema()
Call SearchPDF(Tabelle15.Cells(2, 2).Text)
End Sub

__________________________________________________________________________________________________
In ein Standart Modul kommt:
Option Explicit
Option Private Module
Private Declare PtrSafe Function ShellExecuteA Lib "shell32.dll" ( _
ByVal hwnd As LongPtr, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As LongPtr
Private Const SW_MAXIMIZE As Long = 3

Public Sub SearchPDF(ByVal pvstrNumber As String)
Const FOLDER_PATH As String = "G:\Gesellschaften\*****\********\Kommunikation\Dennis ******* _
\BAckup\Stapelschema\"
Dim astrFolders() As String, strFilename As String
Dim ialngFolders As Long
Dim blnFound As Boolean
astrFolders = GetFolders(FOLDER_PATH)
For ialngFolders = LBound(astrFolders) To UBound(astrFolders)
strFilename = Dir$(astrFolders(ialngFolders) & "*" & pvstrNumber & "*.pdf")
If strFilename  vbNullString Then
blnFound = True
Call ShellExecuteA(0, "OPEN", astrFolders(ialngFolders) & strFilename, _
vbNullString, vbNullString, SW_MAXIMIZE)
Exit For
End If
Next
If Not blnFound Then Call MsgBox("Leider kein Stapelschema vorhanden.", vbExclamation, " _
Hinweis")
End Sub

Private Function GetFolders(ByVal pvstrPath As String) As String()
Dim astrFolders() As String
Dim strFolder As String, strPath As String
Dim ialngIndex1 As Long, ialngIndex2 As Long
ReDim Preserve astrFolders(ialngIndex1)
astrFolders(ialngIndex1) = pvstrPath
ialngIndex1 = 1
ialngIndex2 = 1
strPath = pvstrPath
Do
strFolder = Dir$(PathName:=strPath & "*", Attributes:=vbDirectory)
Do Until strFolder = vbNullString
If strFolder  "." And strFolder  ".." Then
If GetAttr(PathName:=strPath & strFolder) And vbDirectory Then
ReDim Preserve astrFolders(0 To ialngIndex1)
astrFolders(ialngIndex1) = strPath & strFolder & "\"
ialngIndex1 = ialngIndex1 + 1
End If
End If
strFolder = Dir$
Loop
If ialngIndex1 = ialngIndex2 Then Exit Do
strPath = astrFolders(ialngIndex2)
ialngIndex2 = ialngIndex2 + 1
Loop
GetFolders = astrFolders
End Function

Beliebteste Forumthreads (12 Monate)

Filesearch Explorersuche Datei Suchen

Forumthread: Filesearch Explorersuche Datei Suchen

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Filesearch Explorersuche Datei Suchen

Forumthread: Filesearch Explorersuche Datei Suchen

10 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread