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