Dateisuche aus Listbox (geschwindigkeit)
06.11.2008 09:52:49
chris
ich habe eine frage und hoffe ihr könnt mir ein paar Tipps geben.
ich habe eine Listbox auf einer Userform, in dieser Listbox stehen nummern
(0003839482283)
(0045343482283)
(0045343482283)
usw...
Was ich erreichen muss ist eine suche nach diesen Dateien und diese such ergebnisse in einen weitere Listbox eintragen zu lassen.
Ich habe nun schon einen Code für eine schnelle Dateisuche im Forum gefunden.
Nur ich wollte mal nachfragen ob es nicht noch schneller geht ? Weil so ja für jeden Eintrag in der Listbox die suche gestartet wird. Würde mich sehr über Hilfe und gute Tipps freuen.
Hier mein suchmakro.(In der variable suche was steht dann immer der aktuelle wert aus der Listbox
Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Private Const MAX_PATH = 260
Private Const INVALID_HANDLE_VALUE = -1
Private Const FILE_ATTRIBUTE_ARCHIVE = &H20
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
Private Const FILE_ATTRIBUTE_HIDDEN = &H2
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const FILE_ATTRIBUTE_READONLY = &H1
Private Const FILE_ATTRIBUTE_SYSTEM = &H4
Private Const FILE_ATTRIBUTE_TEMPORARY = &H100
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
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 lngDirCount As Long
Private lngFileCount As Long
Private strFiles() As String
Public Sub start_suche(suche_was)
Application.ScreenUpdating = False
lngDirCount = 1
lngFileCount = 0
FindFiles "c:\test\", "*" & suche_was & "*.dat"
Range(Cells(1, 1), Cells(lngFileCount, 1)) = WorksheetFunction.Transpose(strFiles)
frm_Auswertung.ListBox2.List = WorksheetFunction.Transpose(strFiles)
Application.ScreenUpdating = True
End Sub
Private Sub FindFiles(ByVal strFolderPath As String, ByVal strSearch As String)
Dim WFD As WIN32_FIND_DATA
Dim lngSearch As Long
Dim strDirName As String
If Right$(strFolderPath, 1) "\" Then strFolderPath = strFolderPath & "\"
lngSearch = FindFirstFile(strFolderPath & "*.*", WFD)
If lngSearch INVALID_HANDLE_VALUE Then
GetFilesInFolder strFolderPath, strSearch
Do
If (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) Then
strDirName = TrimNulls(WFD.cFileName)
If (strDirName ".") And (strDirName "..") Then
lngDirCount = lngDirCount + 1
FindFiles strFolderPath & strDirName, strSearch
End If
End If
Loop While FindNextFile(lngSearch, WFD)
FindClose lngSearch
End If
End Sub
Private Sub GetFilesInFolder(ByVal strFolderPath As String, ByVal strSearch As String)
Dim WFD As WIN32_FIND_DATA
Dim lngSearch As Long
Dim strFileName As String
If Right$(strFolderPath, 1) "\" Then strFolderPath = strFolderPath & "\"
lngSearch = FindFirstFile(strFolderPath & strSearch, WFD)
If lngSearch INVALID_HANDLE_VALUE Then
Do
If (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) FILE_ATTRIBUTE_DIRECTORY _
_
_
_
Then
strFileName = TrimNulls(WFD.cFileName)
lngFileCount = lngFileCount + 1
ReDim Preserve strFiles(1 To lngFileCount)
strFiles(lngFileCount) = strFolderPath & strFileName
End If
Loop While FindNextFile(lngSearch, WFD)
FindClose lngSearch
End If
End Sub
Private Function TrimNulls(ByVal strStringIn As String) As String
If InStr(strStringIn, Chr(0)) > 0 Then strStringIn = Left$(strStringIn, InStr(strStringIn, _
_
_
_
Chr(0)) - 1)
TrimNulls = strStringIn
End Function