Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1748to1752
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Filesearch Explorersuche Datei Suchen

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.

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

Betreff
Datum
Anwender
Anzeige
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?".
Anzeige
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
Anzeige
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
Anzeige
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

Anzeige
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 =(
Anzeige
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

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige