Hallo,
habe ein kleines Problem.
In einem Formular ist eine Prüfnummer hinterlegt, zu dieser Prüfnummer gibt es irgendwo auf meinem Laufwerk einen Ordner mit Details. Wie kann ich die Prüfnummer aus dem Formular über einen Button in die Explorer suche einbinden damit mir der Inhalt angezeigt wird? So wie ich es bisher habe findet er den Ordner nur wenn ich ihn direkt mit Bezug einbinde, aber wenn er nicht direkt auf Laufwerk F: liegt findet er nichts.
Danke für eure Hilfe
So sieht das momentan aus.
Private Sub Befehl276_Click()
Dim dat As String
Dim prog As String
Dim i As Integer
dat = Forms![Prüfaufträge_neu_zuweisen]![Prüfauftragnummer]
prog = "*.jpg" & "*.pdf"
With Application.FileSearch
.NewSearch
.LookIn = "f:\"
.SearchSubFolders = True
.FileName = prog
.MatchTextExactly = True
End With
'neue suche durchführen
With Application.FileSearch
If .Execute() > 0 Then
MsgBox "Es wurde(n)" & .FoundFiles.Count & "Programm(e) gefunden."
For i = 1 To .FoundFiles.Count
'ant = MsgBox(.FoundFiles(i), vbOK)
Next i
Else
'ant1 = MsgBox("Es wurden keine entsprechende Datei gefunden!", vbOK)
End If
End With
End Sub
Hallo,
wie sollte er auch, wenn Du das LW fest vorgibst:
.LookIn = "f:\"
Hier solltest Du erst die vorhandenen Laufwerke ermitteln und nacheinander in die Suchläufe einbinden.
Willst Du wirklich die gesamten Laufwerke nach der Datei durchsuchen?
Da würde ich eher zu einer geordneten Dateiablage-(Struktur) tendieren wollen.
Hallo,
du könntest in einer Schleife alle Laufwerke durchsuchen.
Siehe z.b. diesen Thread: http://www.office-loesung.de/ftopic116198_0_0_asc.php
Aber ich sags gleich, Filesearch wird ab Office 2007 nicht mehr zur Verfügung stehen.
Einen Link zu einer Alternative habe ich kürzlich gepostet:
http://www.access-o-mania.de/forum/index.php?topic=10416.msg79068#msg79068
Gruß Andreas
Hallo,
der Ordner den ich suchen möchte liegt in irgendeinem Unterordner von LW F: deshalb habe ich direkt LW F: angegeben, klappt dennoch nicht. Wie müsste das in Office 07 aussehen?
Ach ja, suche keine Datei sondern einen Ordner mit der Nummer
Hallo,
sieh mal hier nach ...
http://www.office-loesung.de/ftopic104454_0_0_asc.php (http://www.office-loesung.de/ftopic104454_0_0_asc.php)
ich denke, dass ist ungefähr das was du suchst.
HTH
Hier mal eine etwas andere Lösung, welche das Suchen im Filesystem SQL-likely gestaltet:
Zuerst schubst du dir folgendes Tool von Microsoft (http://www.microsoft.com/downloads/en/details.aspx?FamilyID=890cd06b-abf8-4c25-91b2-f8d975cf8c07&displaylang=en&pf=true) auf deine Platte und installierst es.
Es ist zwar ein Commandozeilentool, ist aber auch in Access erreichbar.
Starte Access und im VBA-Editor unter Verweise das "MS Utility 1.0 Type Libary Log Parser" aktivieren.
Ich hänge mal eine DB mit einem einfachen Bsp mit an.
Es ist zwar kein explicites Bsp dabei was auf deine Aufgabenstellung eingeht, aber wenn ich deine Frage richtig verstanden habe willst du alle Dateien, die in einem o. Mehreren Unetrverzeichnissen deine Prüfsumme beinhalten, auflisten.
Der entsprechende String müsste dann ungefähr im code so lauten:
Private Sub Befehl276_Click()
...
...
dim Prfsum as string
Prfsum = IIf(Len(Nz(Forms![Prüfaufträge_neu_zuweisen]![Prüfauftragnummer], "")) > 0, Forms![Prüfaufträge_neu_zuweisen]![Prüfauftragnummer] & "%'", "'")
...
SQL = "SELECT Path " & _
"FROM 'F:\*'' " & _
"WHERE NAME <> '.' And NAME <> '..' And EXTRACT_PATH(PATH) LIKE '%" & Prfsum & _
" AND NOT ATTRIBUTES LIKE '%D%'"
...
...
End Sub
Wie immer alles ohne Gewähr, zumal ich nur geraten habe da du die Prüfsumme in deinem Code nicht wirklich verwendest.
den Rest der noch dazugehört findest du im Bsp..
[Anhang gelöscht durch Administrator]
Hallo,
das funktioniert alles nicht. In der SQL ist ein Fehler, ich kenne mich mit SQL nicht aus und kann das nicht korrigieren.
Meine Problem in kurzen Worten:
Es gibt Prüfaufträge, jeder hat eine fortlaufende Nummer die im Formular (Forms![Prüfaufträge_neu_zuweisen]![Prüfauftragnummer]) hinterlegt ist. Zu dieser Nummer gibt es einen Ordner auf meinem F: LW in irgendeinem Unterordner. Mit einem Klick aus dem Formular soll über die Prüfauftragnummer im Explorer der identische Ordner gefunden werden und direkt den Inhalt im Explorer anzeigen.
Geht das überhaupt? Wer kann mit das so rüberschieben damit ich es als mittelmäßiger User einbinden kann? Danke euch
Hallo,
versuche mal das ....
SQL = "SELECT Path" & _
" FROM 'F:\*''' & _
" WHERE NAME <> '.' And NAME <> '..' And EXTRACT_PATH(PATH) LIKE '%" & Prfsum & _
"' AND NOT ATTRIBUTES LIKE '%D%'"
Obwohl nicht unerwähnt bleiben darf, dass dieses Codestück KEINE SQL darstellt, wie si für Abfragen, die auf Tabellen abgesetzt werden verwendbar wäre!
Zudem funktioniert das ganze Geblüm nur auf dem Rechner, auf dem auch das Tool installiert wurde!
Funktioniert nicht, Syntaxfehler. Hatte Office 03, jetzt 07, aber bei beiden geht nichts. Wie müsste der komplette Befehl aussehen?
Hallo,
warum verfolgst Du nicht den Link von database aus Antwort #5??
Dort ist alles zu finden, was Dein Problem erschlägt...
Zudem wiederhole ich meinen Tipp, sich besser eine geordnete (und damit ohne Sucherei bekannte) Ordnerstruktur zuzulegen...
weil das nicht geht, es arbeiten mehrere Leute damit und jeder hat unter seinem Namen die Daten abgelegt also muss ich einen Weg finden wie ich aus dem Formular raus den Ordner suchen kann, die Antwort hilft mir leider nicht weiter
habe jetzt alles versucht, es kommt mit Option Explicit die Fehlermeldung: Innerhalb einer Prozedur ungültig, egal wie ich es setze.
Hallo,
Du mußt schon Klartext reden (schreiben)..
Poste den (kompletten diesbezüglichen) Code, den Du nun einsetzt, mit Copy&Paste
wollte die Codes testen, wenn ich aber über den button im Formular aufrufe kommt nur die Fehlermeldung: In einer Prozedur ungültig und er hängt sich an der ersten Zeile auf. Werde bald Wahnsinnig, jeder schreibt, es ist doch ganz einfach, aber bei mir klappt es nicht.
Private Sub Befehl276_Click()
Option Explicit
Public Enum SORT_BY
Sort_by_None
Sort_by_Name
Sort_by_Path
Sort_by_Size
Sort_by_Last_Access
Sort_by_Last_Modyfy
Sort_by_Date_Create
End Enum
Public Enum SORT_ORDER
Sort_Order_Ascending
Sort_Order_Descending
End Enum
Public Type FILEINFO
strFilename As String
strPath As String
lngSize As Long
dmtLastAccess As Date
dmtLastModify As Date
dmtDateCreate As Date
End Type
Public Sub Test()
Dim objFileSearch As clsFileSearch
Dim lngIndex As Long
Set objFileSearch = New clsFileSearch
With objFileSearch
.CaseSenstiv = True
.Extension = "*.xls"
.FolderPath = "D:\"
.SearchLike = "Test*"
.SubFolders = True
If .Execute(Sort_by_Size, Sort_Order_Descending) > 0 Then
For lngIndex = 1 To .FileCount
With .Files(lngIndex)
Debug.Print .strFilename, .lngSize
End With
Next
End If
End With
Set objFileSearch = Nothing
End Sub
Hallo,
der ganze Code gehört in ein Standard-Modul. Nur der Funktionsaufruf ( Test ) passiert aus einer Ereignisprozdur (oder von woanders her)
" jeder schreibt, es ist doch ganz einfach, aber bei mir klappt es nicht. "
Du mußt Dich halt auch erst mit den Grudlagen der VBA-Programmierung auseinandersetzen...
habe das jetzt in ein Modul eingefügt und beim Aufruf kommt Fehlermeldung: Mehrdeutiger Name Sort by, also funktioniert das auch nicht, ich hör auf, da muss jemand anderes ran
Hallo,
Der Code in #14 weist einen groben Fehler auf!
Option Explicit KANN NICHT nach der Deklaration einer Ereignisprozedut stehen!
Also KEINESFFALLS steht Option Explicit NACH Private Sub Befehl276_Click() sondern in der 2. Zeile des Modulkopfes - d.h. NACH Option Compare Database
Nach Anleitung von DF6GL solltest du den Code in eine Standardmodul verfrachten - das scheinst du ja gemacht zu haben - nur WAS hast du dorthin verfrachtet?
Öffne den VBA-Editor,
Öffne ein Modul oder ein Formularmodul
gehe zu Extras Optionen und setzte dort bei 'Variablendeklaration erforderlich' den Haken.
Damit wird Option Explicit in JEDES Neue Modul automatisch eingetragen.
Option Explicit legt fest dass Variablen deklariert werden müssen BEVOR sie verwendet werden - was dann wiederum ausshließt, dass du in deinem Code UNBEKANNTE Variablen einsetzen könntest.
Danach lege ein NEUES Modul an.
N A C H Option Explicit - (das steht ja nun schon an der richtigen Stelle) - kopierst du das da hin:
Public Enum SORT_BY
Sort_by_None
Sort_by_Name
Sort_by_Path
Sort_by_Size
Sort_by_Last_Access
Sort_by_Last_Modyfy
Sort_by_Date_Create
End Enum
Public Enum SORT_ORDER
Sort_Order_Ascending
Sort_Order_Descending
End Enum
Public Type FILEINFO
strFilename As String
strPath As String
lngSize As Long
dmtLastAccess As Date
dmtLastModify As Date
dmtDateCreate As Date
End Type
Public Sub Test()
Dim objFileSearch As clsFileSearch
Dim lngIndex As Long
Set objFileSearch = New clsFileSearch
With objFileSearch
.CaseSenstiv = True
.Extension = "*.xls"
.FolderPath = "D:\"
.SearchLike = "Test*"
.SubFolders = True
If .Execute(Sort_by_Size, Sort_Order_Descending) > 0 Then
For lngIndex = 1 To .FileCount
With .Files(lngIndex)
Debug.Print .strFilename, .lngSize
End With
Next
End If
End With
Set objFileSearch = Nothing
End Sub
In deinem Formular, hast du einen Button namens 'Befehl276' und in dessen Ereignis 'Beim Klicken' schreibst du:
Private Sub Befehl276_Click()
Call Test
End Sub
...und dann schau mal was passiert
HTH
Hallo,
wenn ich das so ausführe kommt der Fehler unter "Public Enum SORT_BY" dass ein Fehler beim Kompilieren vorliegt, Mehrdeutiger Name Sort_by
Was muss ich hier weiter tun?
Habe etwas anderes versucht, es gab bereits ein Modul mit Namen Test deshalb gab es Probleme. Habe das jetzt umbenannt und er läuft bis zur Zeile unter Test "Dim objFileSearch As clsFileSearch" meldet dann "Benutzerdefinierter Typ nicht definiert"
Wieder 2 Stunden gebastelt, jetzt habe ich das Klassenmodul clsfilesearch erstellt (Inhalt aus dem Netz)
Option Compare Database
Option Explicit
Private Declare Function FindFirstFile Lib "kernel32.dll" Alias "FindFirstFileA" ( _
ByVal lpFileName As String, _
ByRef lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32.dll" Alias "FindNextFileA" ( _
ByVal hFindFile As Long, _
ByRef lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32.dll" ( _
ByVal hFindFile As Long) As Long
Private Declare Function FileTimeToLocalFileTime Lib "kernel32.dll" ( _
ByRef lpFileTime As FILETIME, _
ByRef lpLocalFileTime As FILETIME) As Long
Private Declare Function FileTimeToSystemTime Lib "kernel32.dll" ( _
ByRef lpFileTime As FILETIME, _
ByRef lpSystemTime As SYSTEMTIME) As Long
Private Enum FILE_ATTRIBUTE
FILE_ATTRIBUTE_READONLY = &H1
FILE_ATTRIBUTE_HIDDEN = &H2
FILE_ATTRIBUTE_SYSTEM = &H4
FILE_ATTRIBUTE_DIRECTORY = &H10
FILE_ATTRIBUTE_ARCHIVE = &H20
FILE_ATTRIBUTE_NORMAL = &H80
FILE_ATTRIBUTE_TEMPORARY = &H100
End Enum
Private Const MAX_PATH = 260&
Private Const INVALID_HANDLE_VALUE = -1&
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type
Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type
Private mlngFileCount As Long
Private mudtFiles() As FILEINFO
Private mstrFolderPath As String
Private mstrExtension As String
Private mstrSearchLike As String
Private mblnSubFolders As Boolean
Private mblnCaseSenstiv As Boolean
Friend Property Get Files(lngIndex As Long) As FILEINFO
Files = mudtFiles(lngIndex)
End Property
Friend Property Get FileCount() As Long
FileCount = mlngFileCount
End Property
Friend Property Let FolderPath(strFolderPath As String)
mstrFolderPath = strFolderPath
End Property
Friend Property Let Extension(strExtension As String)
mstrExtension = strExtension
End Property
Friend Property Let SearchLike(strSearchLike As String)
mstrSearchLike = strSearchLike
End Property
Friend Property Let SubFolders(blnSubFolders As Boolean)
mblnSubFolders = blnSubFolders
End Property
Friend Property Let CaseSenstiv(blnCaseSenstiv As Boolean)
mblnCaseSenstiv = blnCaseSenstiv
End Property
Friend Function Execute(Optional enmSortBy As SORT_BY = Sort_by_None, _
Optional enmSortOrder As SORT_ORDER = Sort_Order_Ascending) As Long
Call FindFiles(mstrFolderPath)
If mlngFileCount > 1 And enmSortBy <> Sort_by_None Then _
Call prcSort(1, mlngFileCount, enmSortBy, enmSortOrder)
Execute = mlngFileCount
End Function
Private Sub FindFiles(ByVal strFolderPath As String)
Dim WFD As WIN32_FIND_DATA, lngSearch As Long, strDirName As String
On Error GoTo ErrorHandling
If Right$(strFolderPath, 1) <> "\" Then strFolderPath = strFolderPath & "\"
lngSearch = FindFirstFile(strFolderPath & "*.*", WFD)
If lngSearch <> INVALID_HANDLE_VALUE Then
Call GetFilesInFolder(strFolderPath)
If mblnSubFolders Then
Do
If (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) Then
strDirName = Left$(WFD.cFileName, InStr(WFD.cFileName, Chr$(0)) - 1)
If (strDirName <> ".") And (strDirName <> "..") Then _
Call FindFiles(strFolderPath & strDirName)
End If
Loop While FindNextFile(lngSearch, WFD)
End If
FindClose lngSearch
End If
Exit Sub
ErrorHandling:
MsgBox "Fehler " & CStr(Err.Number) & vbLf & vbLf & _
Err.Description, vbCritical, "Fehler"
End Sub
Private Sub GetFilesInFolder(ByVal strFolderPath As String)
Dim WFD As WIN32_FIND_DATA, lngSearch As Long, strFilename As String
Dim udtFiletime As FILETIME, udtSystemtime As SYSTEMTIME
On Error GoTo ErrorHandling
If Right$(strFolderPath, 1) <> "\" Then strFolderPath = strFolderPath & "\"
lngSearch = FindFirstFile(strFolderPath & mstrExtension, WFD)
If lngSearch <> INVALID_HANDLE_VALUE Then
Do
If (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) <> FILE_ATTRIBUTE_DIRECTORY Then
strFilename = Left$(WFD.cFileName, InStr(WFD.cFileName, Chr$(0)) - 1)
If IIf(mblnCaseSenstiv, strFilename, LCase$(strFilename)) Like _
IIf(mblnCaseSenstiv, mstrSearchLike, LCase$(mstrSearchLike)) Then
mlngFileCount = mlngFileCount + 1
ReDim Preserve mudtFiles(1 To mlngFileCount)
With mudtFiles(mlngFileCount)
.strPath = strFolderPath & strFilename
.strFilename = strFilename
.lngSize = WFD.nFileSizeLow
FileTimeToLocalFileTime WFD.ftCreationTime, udtFiletime
FileTimeToSystemTime udtFiletime, udtSystemtime
.dmtDateCreate = CDate(DateSerial(udtSystemtime.wYear, udtSystemtime.wMonth, udtSystemtime.wDay) + _
TimeSerial(udtSystemtime.wHour, udtSystemtime.wMinute, udtSystemtime.wSecond))
FileTimeToLocalFileTime WFD.ftLastAccessTime, udtFiletime
FileTimeToSystemTime udtFiletime, udtSystemtime
.dmtLastAccess = CDate(DateSerial(udtSystemtime.wYear, udtSystemtime.wMonth, udtSystemtime.wDay) + _
TimeSerial(udtSystemtime.wHour, udtSystemtime.wMinute, udtSystemtime.wSecond))
FileTimeToLocalFileTime WFD.ftLastWriteTime, udtFiletime
FileTimeToSystemTime udtFiletime, udtSystemtime
.dmtLastModify = CDate(DateSerial(udtSystemtime.wYear, udtSystemtime.wMonth, udtSystemtime.wDay) + _
TimeSerial(udtSystemtime.wHour, udtSystemtime.wMinute, udtSystemtime.wSecond))
End With
End If
End If
Loop While FindNextFile(lngSearch, WFD)
FindClose lngSearch
End If
Exit Sub
ErrorHandling:
MsgBox "Fehler " & CStr(Err.Number) & vbLf & vbLf & _
Err.Description, vbCritical, "Fehler"
End Sub
Private Sub prcSort(lngLBorder As Long, lngUBorder As Long, enmSortBy As SORT_BY, enmSortOrder As SORT_ORDER)
Dim lngIndex1 As Long, lngIndex2 As Long
Dim udtBuffer As FILEINFO, vntTemp As Variant
lngIndex1 = lngLBorder
lngIndex2 = lngUBorder
Select Case enmSortBy
Case Sort_by_Name: vntTemp = mudtFiles((lngLBorder + lngUBorder) \ 2).strFilename
Case Sort_by_Path: vntTemp = mudtFiles((lngLBorder + lngUBorder) \ 2).strPath
Case Sort_by_Size: vntTemp = mudtFiles((lngLBorder + lngUBorder) \ 2).lngSize
Case Sort_by_Last_Access: vntTemp = mudtFiles((lngLBorder + lngUBorder) \ 2).dmtLastAccess
Case Sort_by_Last_Modyfy: vntTemp = mudtFiles((lngLBorder + lngUBorder) \ 2).dmtLastModify
Case Sort_by_Date_Create: vntTemp = mudtFiles((lngLBorder + lngUBorder) \ 2).dmtDateCreate
End Select
Do
Select Case enmSortBy
Case Sort_by_Name
If enmSortOrder = Sort_Order_Ascending Then
Do While mudtFiles(lngIndex1).strFilename < vntTemp
lngIndex1 = lngIndex1 + 1
Loop
Do While vntTemp < mudtFiles(lngIndex2).strFilename
lngIndex2 = lngIndex2 - 1
Loop
Else
Do While mudtFiles(lngIndex1).strFilename > vntTemp
lngIndex1 = lngIndex1 + 1
Loop
Do While vntTemp > mudtFiles(lngIndex2).strFilename
lngIndex2 = lngIndex2 - 1
Loop
End If
Case Sort_by_Path
If enmSortOrder = Sort_Order_Ascending Then
Do While mudtFiles(lngIndex1).strPath < vntTemp
lngIndex1 = lngIndex1 + 1
Loop
Do While vntTemp < mudtFiles(lngIndex2).strPath
lngIndex2 = lngIndex2 - 1
Loop
Else
Do While mudtFiles(lngIndex1).strPath > vntTemp
lngIndex1 = lngIndex1 + 1
Loop
Do While vntTemp > mudtFiles(lngIndex2).strPath
lngIndex2 = lngIndex2 - 1
Loop
End If
Case Sort_by_Size
If enmSortOrder = Sort_Order_Ascending Then
Do While mudtFiles(lngIndex1).lngSize < vntTemp
lngIndex1 = lngIndex1 + 1
Loop
Do While vntTemp < mudtFiles(lngIndex2).lngSize
lngIndex2 = lngIndex2 - 1
Loop
Else
Do While mudtFiles(lngIndex1).lngSize > vntTemp
lngIndex1 = lngIndex1 + 1
Loop
Do While vntTemp > mudtFiles(lngIndex2).lngSize
lngIndex2 = lngIndex2 - 1
Loop
End If
Case Sort_by_Last_Access
If enmSortOrder = Sort_Order_Ascending Then
Do While mudtFiles(lngIndex1).dmtLastAccess < vntTemp
lngIndex1 = lngIndex1 + 1
Loop
Do While vntTemp < mudtFiles(lngIndex2).dmtLastAccess
lngIndex2 = lngIndex2 - 1
Loop
Else
Do While mudtFiles(lngIndex1).dmtLastAccess > vntTemp
lngIndex1 = lngIndex1 + 1
Loop
Do While vntTemp > mudtFiles(lngIndex2).dmtLastAccess
lngIndex2 = lngIndex2 - 1
Loop
End If
Case Sort_by_Last_Modyfy
If enmSortOrder = Sort_Order_Ascending Then
Do While mudtFiles(lngIndex1).dmtLastModify < vntTemp
lngIndex1 = lngIndex1 + 1
Loop
Do While vntTemp < mudtFiles(lngIndex2).dmtLastModify
lngIndex2 = lngIndex2 - 1
Loop
Else
Do While mudtFiles(lngIndex1).dmtLastModify > vntTemp
lngIndex1 = lngIndex1 + 1
Loop
Do While vntTemp > mudtFiles(lngIndex2).dmtLastModify
lngIndex2 = lngIndex2 - 1
Loop
End If
Case Sort_by_Date_Create
If enmSortOrder = Sort_Order_Ascending Then
Do While mudtFiles(lngIndex1).dmtDateCreate < vntTemp
lngIndex1 = lngIndex1 + 1
Loop
Do While vntTemp < mudtFiles(lngIndex2).dmtDateCreate
lngIndex2 = lngIndex2 - 1
Loop
Else
Do While mudtFiles(lngIndex1).dmtDateCreate > vntTemp
lngIndex1 = lngIndex1 + 1
Loop
Do While vntTemp > mudtFiles(lngIndex2).dmtDateCreate
lngIndex2 = lngIndex2 - 1
Loop
End If
End Select
If lngIndex1 <= lngIndex2 Then
udtBuffer = mudtFiles(lngIndex1)
mudtFiles(lngIndex1) = mudtFiles(lngIndex2)
mudtFiles(lngIndex2) = udtBuffer
lngIndex1 = lngIndex1 + 1
lngIndex2 = lngIndex2 - 1
End If
Loop Until lngIndex1 > lngIndex2
If lngLBorder < lngIndex2 Then Call prcSort(lngLBorder, lngIndex2, enmSortBy, enmSortOrder)
If lngIndex1 < lngUBorder Then Call prcSort(lngIndex1, lngUBorder, enmSortBy, enmSortOrder)
End Sub
Modul Ordnersuche:
Option Compare Database
Option Explicit
Public Enum SORT_BY
Sort_by_None
Sort_by_Name
Sort_by_Path
Sort_by_Size
Sort_by_Last_Access
Sort_by_Last_Modyfy
Sort_by_Date_Create
End Enum
Public Enum SORT_ORDER
Sort_Order_Ascending
Sort_Order_Descending
End Enum
Public Type FILEINFO
strFilename As String
strPath As String
lngSize As Long
dmtLastAccess As Date
dmtLastModify As Date
dmtDateCreate As Date
End Type
Public Sub Test1()
Dim objFileSearch As clsfilesearch
Dim lngIndex As Long
Set objFileSearch = New clsfilesearch
With objFileSearch
.CaseSenstiv = True
.Extension = "*.jpg"
.FolderPath = "f:\"
.SearchLike = "*04891*"
.SubFolders = True
If .Execute(Sort_by_Size, Sort_Order_Descending) > 0 Then
For lngIndex = 1 To .FileCount
With .Files(lngIndex)
Debug.Print .strFilename, .lngSize
End With
Next
End If
End With
Set objFileSearch = Nothing
End Sub
und den Befehl auf test1 geändert.
Es kommt keine Fehlermeldung mehr aber er zeigt mir auch keine Ergebnisse, jetzt komme ich wieder nicht weiter
Zitat...
With objFileSearch
.CaseSenstiv = True
.Extension = "*.jpg"
.FolderPath = "f:\"
.SearchLike = "*04891*"
.SubFolders = True
If .Execute(Sort_by_Size,
...
Evtl. gibt es ja keine Datei ( nicht Path ) die
*04891*.jpg im Namen (nicht Path) beinhaltet, denn
.SearchLike = "*04891*" berücksichtigt nicht die Verzeichnisnamen. Ich erwähne das nur deshalb weil ich mal annehme das
"*04891*" deine Prüfnummer ist, welche ja wiederum zum Teil oder ganz den Verzeichnisnamen darstellt.
Du könntest jetzt diesen Code mit dem von Database in Antwort #5 verlinkten Code kombinieren, bei dem du zuerst den Path suchst, und diesen gefundenen Path in
.FolderPath = ... einsetzt. Dieses setzt aber voraus das das
Prüfnummernverzeichnis nur ein einzigesmal auf der Partition F: vorkommt.Andere Möglichkeit du schreibst den Filesearch-Code ein wenig um so das auch der Path berücksichtigt wird.
Ansonsten könnstest du es ja noch mal mit dem schon erwähnten Logparse probieren, eine Beispiel-DB hatte ich ja in meinem ersten Post mit angehängt.
Hallo,
es gibt nur eine Datei davon, aber er zeigt nichts an, auch nicht im Überwachungsfenster. Wenn ich deine angehängte DB starte und auf die Path suche mit den ... Punkten klicke kommt Fehlermeldung im Modul unter msoFileDialogFolderPicker.
Klick nicht auf den Button mit den "...". Der Code dahinter müsste in einer Zeile angepasst werden. Ist nicht weiter tragisch, tippe in dem Feld links daneben halt selber F:\ ein. Bedenke aber die Suche auf der kompletten Partition kann je nach Anzahl der Files auf dieser dauern.
ok, damit bekomme ich Inhalte angezeigt. Wie kann ich jetzt meine DB weiter anpassen damit der Ordner mit der passenden Prüfauftragnummer angezeigt und direkt in den Ordner im Explorer springt?
PS: ICH BIN KEIN PROFI, MAX. mittelmäßiger User, bitte so, dass ich es auch verstehen kann, danke euch
Evtl. so:
Private Sub Befehl2_Click()
On Error GoTo Sub_Handle_Error
'// ** Wenn Textfelder leer verlasse Sub **
If Len(Nz(Me.TB_Pruefauftragnummer, "")) = 0 Or Len(Nz(Me.TB_Root, "")) = 0 Then
MsgBox "Fehlende Prüfnummer oder Rootangabe"
Exit Sub
End If
Dim lpif As New MSUtil.COMFileSystemInputContextClass
Dim LP As New MSUtil.LogQueryClass
Dim rs As MSUtil.ILogRecordset
Dim rec As MSUtil.ILogRecord
Dim SQL As String, ss As String
Dim sRoot As String
Dim sPath As String
Dim sOut As String
'// ----------------------------------------------------------------------------------------------------------------
'// ** Hole Daten aus den Textboxen **
'// ----------------------------------------------------------------------------------------------------------------
'// ** Prüfnummer **
'// ** Ergebnis: z.B. %\558877 **
sPath = "%\" & Me.TB_Pruefauftragnummer
'// ** Root-Path **
'// ** Ergebnis: z.B. F:\* **
sRoot = Me.TB_Root & IIf(Right(Me.TB_Root, 1) = "\", "", "\") & "*"
'// ** Baue SQL-String **
SQL = "SELECT Path " & _
"FROM '" & sRoot & "' " & _
" Where Name <> '.' And Name <> '..' And Attributes LIKE '%D%' And Path Like '" & sPath & "'"
'// ** nicht die letzte Zugriffszeit verändern **
lpif.preserveLastAccTime = True
'// ** durchsuche auch die Unterverzeichnisse **
'// ** Werte sind: True(-1), False(0), 1, 2, etc. Angabe wie tief gescannt werden soll **
lpif.recurse = True
lpif.useLocalTime = True
'// ** Run SQL **
Set rs = LP.Execute(SQL, lpif)
Do While Not rs.atEnd
Set rec = rs.GetRecord
sOut = rec.getValue("Path") & vbCrLf
If Len(sOut) > 0 Then
'// ** ein Path wurde gefunden, starte den zuerst gefundenen im Explorer **
Shell "explorer.exe " & sOut, vbNormalFocus
Set rec = Nothing
Exit Do
End If
rs.MoveNext
Set rec = Nothing
Loop
rs.Close
Sub_ExitClean:
Set rs = Nothing
Set lpif = Nothing
Set LP = Nothing
'// ** Exit here **
Exit Sub
Sub_Handle_Error:
MsgBox Err.Number & vbCrLf & Err.Description
GoTo Sub_ExitClean
End Sub
Ich hänge mal eine DB mit dem entsprechen Formular an
Hallo,
es wird ein Treiber benötigt den ich nicht habe und nicht im Netz finde "pb_filesearch.dll". Kannst du mir den uploaden?
Das Teil benötigst du nicht, ist nur eine Verweisleiche. Solche Fehlermeldungen kannst du einfach selbst abstellen, du startest den VBA-Editor, klickst in der Menuleiste auf Extras --> Verweise und nimmst alle Haken bei "nicht Vorhanden" raus. Ich häng mal eine hoffentlich bereinigte Bsp mit an.
[Anhang gelöscht durch Administrator]
;) mein erster Schritt nach vorne, das funktioniert und ist fast exakt was ich benötige, danke.
Perfekt wäre es wenn ich das nun in mein Formular einbinden könnte und die Prüfnummer automatisch gesetzt wird. Kann man das machen?
Die Prüfauftragnummer ist im Formular: [prüfaufträge_neu_zuweisen]![Prüfauftragnummer] hinterlegt, das LW F:\kann statisch bleiben, es liegen alle auf F:\ nur die Unterordner müssen variable gefunden werden, wie in deinem Beispiel.
Wie müsste ich das integrieren?
Die Sub wie im Beispiel in deinem Buttonklick übernehmen mit folgender Änderung:
Private Sub Befehl276_Click()
On Error GoTo Sub_Handle_Error
'// ** Wenn Textfelder leer verlasse Sub **
If Len(Nz(Me![prüfaufträge_neu_zuweisen]![Prüfauftragnummer], "")) = 0 Then
MsgBox "Fehlende Prüfnummer"
Exit Sub
End If
Dim lpif As New MSUtil.COMFileSystemInputContextClass
Dim LP As New MSUtil.LogQueryClass
Dim rs As MSUtil.ILogRecordset
Dim rec As MSUtil.ILogRecord
Dim SQL As String, ss As String
Dim sPath As String
Dim sOut As String
'// ----------------------------------------------------------------------------------------------------------------
'// ** Hole Prüfnummer **
'// ----------------------------------------------------------------------------------------------------------------
sPath = "%\" & Me![prüfaufträge_neu_zuweisen]![Prüfauftragnummer]
'// ** Baue SQL-String **
SQL = "SELECT Path " & _
"FROM 'F:\*' " & _
" Where Name <> '.' And Name <> '..' And Attributes LIKE '%D%' And Path Like '" & sPath & "'"
'// ** nicht die letzte Zugriffszeit verändern **
lpif.preserveLastAccTime = True
'// ** durchsuche auch die Unterverzeichnisse **
'// ** Werte sind: True(-1), False(0), 1, 2, etc. Angabe wie tief gescannt werden soll **
lpif.recurse = True
lpif.useLocalTime = True
'// ** Run SQL **
Set rs = LP.Execute(SQL, lpif)
Do While Not rs.atEnd
Set rec = rs.GetRecord
sOut = rec.getValue("Path") & vbCrLf
If Len(sOut) > 0 Then
'// ** ein Path wurde gefunden, starte den zuerst gefundenen im Explorer **
Shell "explorer.exe " & sOut, vbNormalFocus
Set rec = Nothing
Exit Do
End If
rs.MoveNext
Set rec = Nothing
Loop
rs.Close
Sub_ExitClean:
Set rs = Nothing
Set lpif = Nothing
Set LP = Nothing
'// ** Exit here **
Exit Sub
Sub_Handle_Error:
MsgBox Err.Number & vbCrLf & Err.Description
GoTo Sub_ExitClean
end Sub
Hallo,
in der Zeile Dim lpif As New MSUtil.COMFileSystemInputContextClass bringt er Fehler beim Kompiliere,
benutzerdefinierter Typ nicht definiert.
Ergänzung: Nur wenn ich die Formulare und Module in meine DB einbinde, im Original funktioniert alles.
:o Ich habs, mir hatten 2 Verweise gefehlt, habe das in meiner DB angepasst, den Code auf den Bezug der Prüfauftragnummer des Formulares etwas angepasst weil er ihn nicht finden konnte.
DANKE AN ALLE, habe nebenbei sehr sehr viel gelernt
;)
Nach dem das alles so super funktioniert nächste Frage meiner Kollegen.
Kann ich das auch in einem anderen Formular so anpassen, dass er mir ein pdf File sucht bei dem die Prüfauftragnummer Teil der Datei ist?
Habe das versucht, er öffnet aber nur die Datei wenn nur die Prüfnummer als Name hinterlegt ist, nicht aber noch zusätzliche Zeichen enthält. Gibt es hierfür einen Platzhalter den ich vor und nach die Prüfauftragnummer setzen kann?
Private Sub Prüfauftragnummer_DblClick(Cancel As Integer)
Dim Target_pfad As String
Dim Target_datei As String
Target_pfad = "F:\Dokumente\"
Target_datei = "Prüfauftragnummer" & ".pdf"
Shell "explorer.exe " & Target_pfad & Target_datei, vbNormalFocus
End Sub
ZitatPrivate Sub Prüfauftragnummer_DblClick(Cancel As Integer)
Dim Target_pfad As String
Dim Target_datei As String
Target_pfad = "F:\Dokumente\"
Target_datei = "Prüfauftragnummer" & ".pdf"
Shell "explorer.exe " & Target_pfad & Target_datei, vbNormalFocus
End Sub
Was willst du mit diesem Code erreichen? Ist die datei die du jetzt suchst fest in dem Verzeichnis
F:\Dokumente\, also z.B. F:\Dokumente\Bericht_558877_nr1.pdf?
Wenn ja dann reicht ein
sPrfNr = Me![prüfaufträge_neu_zuweisen]![Prüfauftragnummer]
sFile = Dir$("F:\Dokumente\*" & sPrfNr & "*.pdf")
if Len(sFile) > 0 then
'tja damit zur 2ten Frage
...
end if
Und was willst du mit
Shell "explorer.exe " & Target_pfad & Target_datei, vbNormalFocus erreichen?
Diese Zeile veranlasst den Explorer die datei zu downloaden und die entsprechende Anwendung zu öffnen, hier wahrscheinlich der AdobeReader.
Sollte dies gewollt sein ist die Zeile
Application.FollowHyperlink "F:\Dokumente\" & sFile in den obigen Code einzufügen.
funktioniert, danke.
Das war ein anderes Thema als das obige. Im ersten Ansatz wollten sie den Ordner öffnen in dem die Prüfaufträge als Word und Bilder enthalten sind, das klappt auch super.
Der zweite Schritt ist aus einem anderen Formular heraus auf die PDF Files die als Sicherungskopie der Word Dokumente in einem Ordner "Dokumente abgelegt sind, klappt auch.
Kann man es auch so einstellen, dass ich ein Fenster angezeigt bekomme mit den pdf Files? Es ist möglich, dass ein Prüfauftrag 2 Seiten hat, dann enthält die erste Seite die Prüfauftragnummer mit Seite 1 und die zweite entsprechend mit einer 2?