Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1040to1044
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
Inhaltsverzeichnis

@Sepp und alle: Frage zu FileSearchINFO

@Sepp und alle: Frage zu FileSearchINFO
17.01.2009 12:24:00
Erich
Hallo Sepp (und alle anderen natürlich auch),
bei der Anwendung der Funktion FileSearchINFO aus
https://www.herber.de/forum/archiv/1040to1044/t1040526.htm#1040532
ist mir etwas aufgefallen, das ich mir nicht erklären kann.
Die Funktion gibt das Suchergebnis als Variant-Array zurück, dessen Elemente
(nach der Abgabe im Überwachungsfenster) vom Typ Variant/Object/File sind.
Die Eigenschaften der gelisteten Files lassen sich auch schön abrufen und z. B. in eine Tabelle schreiben.
Das habe ich damit gemacht:

Sub ListFiles()
Dim result As Long, ii As Long, arrF
result = FileSearchINFO(arrF, "c:\temp\", "*.*", True)
If result > 0 Then
For ii = 0 To UBound(arrF)
If ii 0 0=Empty
MsgBox TypeName(arrF)      ' Variant
MsgBox TypeName(arrF(0))   ' File,  bei ii>0 Empty
Cells(1, 2) = arrF(0).Name        ' bei ii>0 Error 424 - Objekt erforderlich
End If
With arrF(ii)                 ' im Überw.-fenster wird arrF(ii) empty !!
Cells(ii + 2, 1) = Left(.Path, Len(.Path) - Len(.Name) - 1)
Cells(ii + 2, 2) = .Name
Cells(ii + 2, 3) = .Size
Cells(ii + 2, 4) = .DateLastModified
End With
Next
End If
End Sub

Und nun die "Merkwürdigkeit":
Nach dem "With arrF(ii)" wird der Typ von arrF(ii) im Überw.-fenster auf "empty" geändert.
Bei ii=1 ist es nicht mehr möglich, noch einmal auf arrF(0) zuzugreifen. Die Anweisung
Cells(1, 2) = arrF(0).Name
führt zum Error 424 - Objekt erforderlich
Das wirkt auf mich wie eine Einmalpackung - Ex und Hopp...
Wie geht da die Info über die Struktur des Arrays verloren?
Sicher, man kann sich die Infos woanders "sicherer" ablegen. Aber ich würds halt gern verstehen!
In der Hoffnung auf Aufklärung - Grü0e von Erich aus Kamp-Lintfort
P.S.:
Sorry, eigentlich war das war keine Frage zu Sepps Funktion. Aber die Frage
nach der Überlebenszeit der Info hat sich mir bei deren Anwendung aufgetan
und ich war bisher zu faul, ein anderes Beispiel zu basteln...

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: @Sepp und alle: Frage zu FileSearchINFO
17.01.2009 13:13:00
Daniel
Hi
ich vermute mal, daß liegt an der VARIANT-Deklation von "arrF" bzw "Files", bzw daran, daß WITH nicht erkennt, daß die Variant-Variable "arrF" bereits ein Objekt ist, und ein neues Objekt für "arrF" erstellt
Wenn in deinem Makro und in der Funkton die beiden Variablen "arrF" und "Files" als Objekt-Datenfelder deklariert werden, dann funktioniert der Code mit der With-Klammer.

Dim result As Long, ii As Long, arrF() As Object
Private Function FileSearchINFO(ByRef Files() As Object, ByVal InitialPath ...


meiner Ansicht nach ist es ein Excel-Bug, der bei einer sauberen Variablendeklaration (dh wenn möglich keine VARIANT-Variablen) nicht zum Tragen kommt.
Gruß, Daniel

Anzeige
Bin zwar Sepp und alle, aber trotzdem ;-)
17.01.2009 13:18:00
Nepumuk
Hallo Erich,
warum dem so ist kann habe ich auch noch nicht herausgefunden. Liegt wahrscheinlich an der Struktur (Variant/Variant/Object). Aber ich würde so etwas auch nicht mit einem Variant machen. Wenn ich ein Objektarray erwarte, dann benutze ich auch ein solches. Versuch es mal so:
' **********************************************************************
' Modul: Modul2 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Private Function FileSearchINFO(ByRef Files() As Object, ByVal InitialPath As String, Optional ByVal FileName As String = "*", _
        Optional ByVal SubFolders As Boolean = False) As Long

    
    '# PARAMETERINFO:
    '# Files: Datenfeld zur Ausgabe der Suchergebnisse
    '# InitialPath: String der das zu durchsuchende Verzeichnis angibt
    '# FileName: String der den gesuchten Dateityp oder Dateinamen enthält (Optional, Standard="*.*" findet alle Dateien)
    '# Beispiele: "*.txt" - Findet alle Textdateien
    '# "*name*" - Findet alle Dateien mit "name" im Dateinamen
    '# "*.avi;*.mpg" - Findet .avi und .mpg Dateien (Dateitypen mit ; trennen)
    '# SubFolders: Boolean gibt an, ob Unterordner durchsucht werden sollen (Optional, Standard=False)
    
    
    Dim fobjFSO As Object, ffsoFolder As Object, ffsoSubFolder As Object, ffsoFile As Object
    Dim intC As Integer, varFiles As Variant
    
    Set fobjFSO = CreateObject("Scripting.FileSystemObject")
    
    Set ffsoFolder = fobjFSO.GetFolder(InitialPath)
    
    On Error Resume Next
    
    If InStr(1, FileName, ";") > 0 Then
        varFiles = Split(FileName, ";")
    Else
        Redim varFiles(0)
        varFiles(0) = FileName
    End If
    For Each ffsoFile In ffsoFolder.Files
        If Not ffsoFile Is Nothing Then
            For intC = 0 To UBound(varFiles)
                If LCase(fobjFSO.GetFileName(ffsoFile)) Like LCase(varFiles(intC)) Then
                    If IsArray(Files) Then
                        Redim Preserve Files(UBound(Files) + 1)
                    Else
                        Redim Files(0)
                    End If
                    Set Files(UBound(Files)) = ffsoFile
                End If
            Next
        End If
    Next
    
    If SubFolders Then
        For Each ffsoSubFolder In ffsoFolder.SubFolders
            FileSearchINFO Files, ffsoSubFolder, FileName, SubFolders
        Next
    End If
    
    If IsArray(Files) Then FileSearchINFO = UBound(Files) + 1
    On Error GoTo 0
    Set fobjFSO = Nothing
    Set ffsoFolder = Nothing
End Function

Sub ListFiles()
    Dim result As Long, ii As Long, arrF() As Object
    
    result = FileSearchINFO(arrF, "c:\temp\", "*.*", True)
    If result > 0 Then
        For ii = 0 To UBound(arrF)
            If ii < 2 Then
                Debug.Print VarType(arrF) ' 8204 8192=Array + 12=Variant
                Debug.Print VarType(arrF(0)) ' 8=String, bei ii>0 0=Empty
                Debug.Print TypeName(arrF) ' Variant
                Debug.Print TypeName(arrF(0)) ' File, bei ii>0 Empty
                Cells(1, 2) = arrF(0).Name ' bei ii>0 Error 424 - Objekt erforderlich
            End If
            With arrF(ii) ' im Überw.-fenster wird arrF(ii) empty !!
                Cells(ii + 2, 1) = Left(.Path, Len(.Path) - Len(.Name) - 1)
                Cells(ii + 2, 2) = .Name
                Cells(ii + 2, 3) = .Size
                Cells(ii + 2, 4) = .DateLastModified
            End With
        Next
    End If
End Sub

Gruß
Nepumuk
Anzeige
AW: Da lag Daniel wohl richtig
17.01.2009 15:34:00
Gerd
Hallo!
Sub ListFiles()
Dim result As Long, ii As Long, arrF
Dim O As Object
result = FileSearchINFO(arrF, "c:\Eigene Dateien\", "*.*", True)
If result > 0 Then
For ii = 0 To UBound(arrF)
If ii MsgBox VarType(arrF) ' 8204 8192=Array + 12=Variant
MsgBox VarType(arrF(0)) ' 8=String, bei ii>0 0=Empty
MsgBox TypeName(arrF) ' Variant
MsgBox TypeName(arrF(0)) ' File, bei ii>0 Empty
Cells(ii + 1, 5) = arrF(ii).Name
Cells(ii + 1, 1) = arrF(0).Name ' bei ii>0 Error 424 - Objekt erforderlich
Set O = arrF(ii)
With O ' im Überw.-fenster wird arrF(ii) empty !!
Cells(ii + 1, 8) = Left(.Path, Len(.Path) - Len(.Name) - 1)
Cells(ii + 1, 12) = .Name
Cells(ii + 1, 15) = .Size
Cells(ii + 1, 16) = .DateLastModified
End With
End If
Next
End If
End Sub


'by J.Ehrensberger


Private Function FileSearchINFO(ByRef Files As Variant, ByVal InitialPath As String, Optional  _
ByVal FileName As String = "*", _
Optional ByVal SubFolders As Boolean = False) As Long
'# PARAMETERINFO:
'# Files: Datenfeld zur Ausgabe der Suchergebnisse
'# InitialPath: String der das zu durchsuchende Verzeichnis angibt
'# FileName: String der den gesuchten Dateityp oder Dateinamen enthält (Optional, Standard=" _
*.*" findet alle Dateien)
'# Beispiele: "*.txt" - Findet alle Textdateien
'# "*name*" - Findet alle Dateien mit "name" im Dateinamen
'# "*.avi;*.mpg" - Findet .avi und .mpg Dateien (Dateitypen mit ; trennen)
'# SubFolders: Boolean gibt an, ob Unterordner durchsucht werden sollen (Optional, Standard= _
False)
Dim fobjFSO As Object, ffsoFolder As Object, ffsoSubFolder As Object, ffsoFile As Object
Dim intC As Integer, varFiles As Variant
Set fobjFSO = CreateObject("Scripting.FileSystemObject")
Set ffsoFolder = fobjFSO.GetFolder(InitialPath)
On Error Resume Next
If InStr(1, FileName, ";") > 0 Then
varFiles = Split(FileName, ";")
Else
ReDim varFiles(0)
varFiles(0) = FileName
End If
For Each ffsoFile In ffsoFolder.Files
If Not ffsoFile Is Nothing Then
For intC = 0 To UBound(varFiles)
If LCase(fobjFSO.GetFileName(ffsoFile)) Like LCase(varFiles(intC)) Then
If IsArray(Files) Then
ReDim Preserve Files(UBound(Files) + 1)
Else
ReDim Files(0)
End If
Set Files(UBound(Files)) = ffsoFile
End If
Next
End If
Next
If SubFolders Then
For Each ffsoSubFolder In ffsoFolder.SubFolders
FileSearchINFO Files, ffsoSubFolder, FileName, SubFolders
Next
End If
If IsArray(Files) Then FileSearchINFO = UBound(Files) + 1
On Error GoTo 0
Set fobjFSO = Nothing
Set ffsoFolder = Nothing
End Function


Grüße Gerd

Anzeige
Danke an Daniel, Nepumuk, Gerd L
17.01.2009 17:38:00
Erich
Hallo zusammen,
danke für eure Antworten!
Die angebrachten und sinnvolleren Deklarationen als Object Arrays hatte ich auch schon versucht,
nachdem ich meinen Anfangsbeitrag eingestellt hatte. Das "Problem" ist also keines mehr.
Umso schöner, dass ihr beide, Daniel und Gerd, etwas WITH-Licht ins dunkle Phänomen gebracht habt.
Es ist nicht mehr wichtig, ob es nun in der X-Akte verstaubt oder im Handbuch des unnützen Wissens archiviert wird.
Natürlich:
So manche Abnormität hilft mehr zum Verständnis so einer Black Box als der langweilige Normalfall.
Grüße und Dank von Erich aus Kamp-Lintfort
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige