Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
620to624
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
620to624
620to624
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Suche nach zip-Dateien mit dem FileSearch-Objekt

Suche nach zip-Dateien mit dem FileSearch-Objekt
13.06.2005 10:55:05
Peter
Hallo zusammen,
ich habe ein Problem (?) mit der Anwendung des FileSearch-Objektes.
Ich möchte eine komplette Festplatte nach zip-Dateien durchsuchen und alle gefundenen in Spalte A einer Tabelle auflisten.
Als Ergebnis bekomme ich jedoch immer eine leere Menge zurück. Suche ich jedoch z.B. nach XLS-Dateien so klappt alles wunderbar ...
Der relevante Teil des Codings sieht dabei wie folgt aus:
strPath = "F:\"
With objFS
.NewSearch
.LookIn = strPath
.SearchSubFolders = True
.Filename = "*.zip"
.MatchTextExactly = False
.FileType = msoFileTypeAllFiles
.Execute
End With
Habt Ihr eine Idee wo der Fehler liegt?
Vielen Dank für Eure Bemühungen und viele Grüße
Peter

11
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Suche nach zip-Dateien mit dem FileSearch-Objekt
13.06.2005 11:04:59
MichaV
Hi,
nur Idee: lass mal .FileType = msoFileTypeAllFiles weg.
Gruss- Micha
AW: Suche nach zip-Dateien mit dem FileSearch-Obje
13.06.2005 11:06:32
Peter
Hallo Micha,
hab' ich schon versucht - bringt leider auch nichts
Gruß
Peter
AW: Suche nach zip-Dateien mit dem FileSearch-Obje
13.06.2005 11:12:25
MichaV
Hi,
vielleicht hilft Dir zu wissen, das es bei mir funzt. Ist also kein Code- Problem.

With Application.FileSearch
.NewSearch
.LookIn = "e:\"
.SearchSubFolders = True
.Filename = "*.zip"
.MatchTextExactly = False
.FileType = msoFileTypeAllFiles
.Execute
MsgBox .FoundFiles.Count
End With

(Win2k mit XL9.0)
Gruss- Micha
AW: Suche nach zip-Dateien mit dem FileSearch-Obje
13.06.2005 11:19:21
Peter
Hallo Micha
und vielen Dank fürs Ausprobieren.
Bei mir klappt es nur mit anderen Datei-Endungen.
Aber jetzt weiß ich ja, woran es nicht liegen kann - ich forsche an anderen Ecken.
Vielen Dank nochmals
Gruß
Peter
Anzeige
AW: Suche nach zip-Dateien mit dem FileSearch-Obje
13.06.2005 11:50:30
Peter
Nochmals Hallo,
jetzt hab' ich an allen Ecken gesucht die mir noch einfallen ... aber klappen tut es immer noch nicht.
Ich finde alle Dateitypen - nur keine zip-Archive.
Wenn ich nach "*.*" suche werden die Archive nicht mitgezählt.
Habt Ihr noch andere Ideen um meinen Tag zu retten ?
Vielen Dank und viele Grüße
Peter
AW: Suche nach zip-Dateien mit dem FileSearch-Obje
13.06.2005 16:41:40
Nepumuk
Hallo Peter,
folgenden Code in ein Standardmodul:
Option Explicit
Option Private Module

Private Declare Function MoveWindow Lib "user32.dll" ( _
    ByVal hwnd As Long, _
    ByVal x As Long, _
    ByVal y As Long, _
    ByVal nWidth As Long, _
    ByVal nHeight As Long, _
    ByVal bRepaint As Long) As Long
Private Declare Function GetSystemMetrics Lib "user32.dll" ( _
    ByVal nIndex As Long) As Long
Private Declare Function GetWindowRect Lib "user32.dll" ( _
    ByVal hwnd As Long, _
    ByRef lpRect As RECT) As Long
Private Declare Function SHBrowseForFolder Lib "shell32" ( _
    lpbi As InfoT) As Long
Private Declare Function CoTaskMemFree Lib "ole32" ( _
    ByVal hMem As Long) As Long
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" ( _
    ByVal lpStr1 As String, _
    ByVal lpStr2 As String) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" ( _
    ByVal pList As Long, _
    ByVal lpBuffer As String) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
    ByVal lpClassname As String, _
    ByVal lpWindowName As String) As Long
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" ( _
    ByVal hwnd As Long, _
    ByVal Msg As Long, _
    wParam As Any, _
    lParam As Any) As Long

Private Type InfoT
    hwnd As Long
    Root As Long
    DisplayName As Long
    Title As Long
    Flags As Long
    FName As Long
    lParam As Long
    Image As Long
End Type

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Public Enum BIF_Flag
    BIF_RETURNONLYFSDIRS = &H1
    BIF_DONTGOBELOWDOMAIN = &H2
    BIF_STATUSTEXT = &H4
    BIF_RETURNFSANCESTORS = &H8
    BIF_EDITBOX = &H10
    BIF_VALIDATE = &H20
    BIF_NEWDIALOGSTYLE = &H40
    BIF_BROWSEINCLUDEURLS = &H80
    BIF_BROWSEFORCOMPUTER = &H1000
    BIF_BROWSEFORPRINTER = &H2000
    BIF_BROWSEINCLUDEFILES = &H4000
    BIF_SHAREABLE = &H8000
End Enum

Private Const SM_CXFULLSCREEN = &H10
Private Const SM_CYFULLSCREEN = &H11

Private Const BFFM_SETSELECTION = &H466
Private Const BFFM_INITIALIZED = &H1

Private s_BrowseInitDir As String

Public Function fncGetFolder( _
        Optional ByVal sMsg As String = "Bitte wählen Sie ein Verzeichnis", _
        Optional ByVal lFlag As BIF_Flag = BIF_RETURNONLYFSDIRS, _
        Optional ByVal sPath As String = "C:\") As String

    Dim xl As InfoT, IDList As Long, RVal As Long, FolderName As String
    s_BrowseInitDir = sPath
    With xl
        .hwnd = FindWindow("XLMAIN", Application.Caption)
        .Root = 0
        .Title = lstrcat(sMsg, "")
        .Flags = lFlag
        .FName = FuncCallback(AddressOf BrowseCallback)
    End With
    IDList = SHBrowseForFolder(xl)
    If IDList <> 0 Then
        FolderName = Space(256)
        RVal = SHGetPathFromIDList(IDList, FolderName)
        CoTaskMemFree (IDList)
        FolderName = Trim$(FolderName)
        FolderName = Left$(FolderName, Len(FolderName) - 1)
    End If
    fncGetFolder = FolderName
End Function

Private Function BrowseCallback( _
        ByVal hwnd As Long, _
        ByVal uMsg As Long, _
        ByVal wParam As Long, _
        ByVal lParam As Long) As Long

    If uMsg = BFFM_INITIALIZED Then
        Call SendMessage(hwnd, BFFM_SETSELECTION, ByVal 1&, ByVal s_BrowseInitDir)
        Call CenterDialog(hwnd)
    End If
    BrowseCallback = 0
End Function

Private Function FuncCallback(ByVal nParam As Long) As Long
    FuncCallback = nParam
End Function

Private Sub CenterDialog(ByVal hwnd As Long)
    Dim WinRect As RECT, ScrWidth As Integer, ScrHeight As Integer
    Dim DlgWidth As Integer, DlgHeight As Integer
    GetWindowRect hwnd, WinRect
    DlgWidth = WinRect.Right - WinRect.Left
    DlgHeight = WinRect.Bottom - WinRect.Top
    ScrWidth = GetSystemMetrics(SM_CXFULLSCREEN)
    ScrHeight = GetSystemMetrics(SM_CYFULLSCREEN)
    MoveWindow hwnd, (ScrWidth - DlgWidth) / 2, _
        (ScrHeight - DlgHeight) / 2, DlgWidth, DlgHeight, 1
End Sub

Diesen Code in ein weiteres Standardmodul:
Option Explicit

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 Enum Fileattribute
    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 INVALID_HANDLE_VALUE = -1

Private Const MAX_PATH As Long = 260

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 strFiles() As String
Private lngFilecount As Long

Public Sub start()
    Dim strFolder As String
    strFolder = Trim$(fncGetFolder(sPath:="F:\"))
    If strFolder <> "" Then
        Erase strFiles
        lngFilecount = 0
        FindFiles strFolder, "*.zip"
        Cells.ClearContents
        If lngFilecount <> 0 Then _
            Range(Cells(1, 1), Cells(lngFilecount, 1)).Value = _
            WorksheetFunction.Transpose(strFiles)
        Columns(1).AutoFit
    End If
End Sub

Private Sub FindFiles(ByVal strFolderPath As String, ByVal strSearch As String)
    Dim WFD As WIN32_FIND_DATA, lngSearch As Long, 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 = Left$(WFD.cFileName, InStr(WFD.cFileName, Chr(0)) - 1)
                If (strDirName <> ".") And (strDirName <> "..") Then _
                    FindFiles strFolderPath & strDirName, strSearch
            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, lngSearch As Long, 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 = Left$(WFD.cFileName, InStr(WFD.cFileName, Chr(0)) - 1)
                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

Gruß
Nepumuk
Anzeige
AW: Suche nach zip-Dateien mit dem FileSearch-Obje
13.06.2005 17:19:54
MichaV
Respekt! Nepomuk,
fehlt oben nicht noch ein Option Base 5 ?
Nun kläre aber bitte wenigstens mich auf. Warum hats bei mir geklappt, bei ihm aber nicht?
Gruß- Micha
AW: Suche nach zip-Dateien mit dem FileSearch-Obje
13.06.2005 17:31:09
Nepumuk
Hallo Micha,
A: Und Option Compare nicht vergessen !!!
B: Keine Ahnung, eventuell eine Macken von 2003. Denn, bei mir geht das auch mit Filesearch.
Gruß
Nepumuk
ich kaufe ein U
13.06.2005 20:03:09
MichaV
sorry NepUmuk,
wollt Dir kein O für ein U vormachen.
Gruß- Micha
AW: Suche nach zip-Dateien mit dem FileSearch-Objekt
13.06.2005 12:28:57
Jan
Hi,
verwende:
Scripting.Filesystemobject
dann klaptts auch mit den zip!
mfg Jan
AW: Suche nach zip-Dateien mit dem FileSearch-Objekt
14.06.2005 12:16:19
Peter
Hallo an alle und vielen Dank für Eure umfangreiche Hilfestellung,
Ich habe mittlerweile herausgefunden, daß es tatsächlich ein Bug im Zusammenspiel zwischen Excel XP/2003 und Windows XP ist, der das Finden von zip-Dateien verhindert.
Viele Grüße
Peter
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige