OT @Nepumuk, Dateien suchen
20.01.2011 20:52:07
Tino
Hallo Nepumuk,
ich verwende einen etwas abgeänderten Code von Dir um Dateien zu suchen
weil dieser Code sehr schnell ist.
Auf manschen Rechnern mit Win- XP funktioniert dieser Code aber leider nicht.
Es kommt kein Fehler,
es wird aber auch keine Datei gefunden auch wenn diese definitiv vorhanden sind.
Wiederrum auf anderen Rechnern geht dieser Code super, ob XP, Vista o. Win7.
Hast Du vielleicht eine Erklärung dafür und evtl. eine alternative die genauso schnell ist.
kommt als Code in Modul1
Option Explicit
Public Sub Start()
Dim strFolder As String, sString As String, FileFilter$, ArFileFilter()
Dim nCount As Long, lngFilecount As Long
Dim ArrayData()
With Tabelle1
'Tabelle leer machen für neue Daten
.Range("A2", .Cells(.Rows.Count, 1)).ClearContents
ArFileFilter = Array("*.pdf", "*.jpg", "*.msg", "*.xls") 'Filter für die Suche
strFolder = OrdnerAuswahl("G:\") 'hier der Pfad aus B1
If strFolder <> "" Then
strFolder = IIf(Right$(strFolder, 1) = "\", strFolder, strFolder & "\")
FindFiles ArrayData, strFolder, lngFilecount, ArFileFilter, True
End If
If lngFilecount > 0 Then
.Range("A2").Resize(lngFilecount, 1) = Application.Transpose(ArrayData)
End If
End With
Erase ArrayData
End Sub
kommt als Code in Modul2
Option Explicit
'Teile des Originalcode von Nepumuk. ***********************************************************
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" ( _
ByVal lpFileName As String, _
lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" ( _
ByVal hFindFile As Long, _
lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32" ( _
ByVal hFindFile As Long) As Long
Private Const INVALID_HANDLE_VALUE = -1&
Private Const MAX_PATH = 260&
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
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 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
'Ordner Dialog
Public Function OrdnerAuswahl(Optional ByVal sPath As String = "C:\")
Dim strOrdner As String
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = sPath
.Title = "Ordnerauswahl"
.ButtonName = "Auswahl..."
.InitialView = msoFileDialogViewList
If .Show = -1 Then
strOrdner = .SelectedItems(1)
If Right(strOrdner, 1) <> "\" Then strOrdner = strOrdner & "\"
Else
strOrdner = ""
End If
End With
OrdnerAuswahl = strOrdner
End Function
Sub FindFiles(ArrayData(), ByVal strFolderPath As String, _
ByRef lngFilecount As Long, ArFileFilter, Optional SubFolder As Boolean = True)
Dim WFD As WIN32_FIND_DATA, lngSearch As Long, strDirName As String
lngSearch = FindFirstFile(strFolderPath & "*.*", WFD)
If lngSearch <> INVALID_HANDLE_VALUE Then
GetFilesInFolder ArrayData, strFolderPath, lngFilecount, ArFileFilter
Do
If (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) Then
strDirName = Left$(WFD.cFileName, InStr(WFD.cFileName, Chr(0)) - 1)
If SubFolder = False Then Exit Sub 'ohne Unterordner
If (strDirName <> ".") And (strDirName <> "..") Then _
FindFiles ArrayData, strFolderPath & strDirName & "\", lngFilecount, ArFileFilter
End If
Loop While FindNextFile(lngSearch, WFD)
FindClose lngSearch
End If
End Sub
Sub GetFilesInFolder(ArrayData(), ByVal strFolderPath As String, _
ByRef lngFilecount As Long, ArFileFilter)
Dim WFD As WIN32_FIND_DATA, lngSearch As Long, strFileName As String
Dim FileFilter
For Each FileFilter In ArFileFilter
lngSearch = FindFirstFile(strFolderPath & FileFilter, 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)
Redim Preserve ArrayData(lngFilecount)
ArrayData(lngFilecount) = strFolderPath & strFileName 'auflisten in Zelle
lngFilecount = lngFilecount + 1
End If
Loop While FindNextFile(lngSearch, WFD)
FindClose lngSearch
End If
Next
End Sub
Gruß Tino