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

Kennzeichen-DateLastModified | Herbers Excel-Forum

Kennzeichen-DateLastModified
27.04.2012 13:41:26
robert

Hallo,
mit diesem Teil-Codeschnipsel, LastModified=5
werden alle Dateien des Vormonats aufgelistet.
Für die Dateilistung Excel2010 habe ich einen Code,
mir geht es um die Kennzeichen (0 bis 6).
Wie suche ich da in Excel2010 ?
Gruß
robert
Set fs = Application.FileSearch
Application.EnableEvents = False
With fs
.LookIn = sPath
.SearchSubFolders = True
.Filename = Range("I1") '"*.xls"
.LastModified = 5 ' Änderungsdatum im Vormonat
.Execute
For iCounter = 1 To .FoundFiles.Count
Cells(iCounter, 1).Value = .FoundFiles(iCounter)
s = .FoundFiles(iCounter)
Call Show(s)
Cells(iCounter, 2).Value = s
Next iCounter
End With

16
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
@Sepp-bitte um Hilfe-dein Makro
27.04.2012 19:43:58
robert
Hi,
ich versuche seit geraumer Zeit die Selektion mit den Kennzeichzen
0-6 für LastModified hinzukriegen-ich schaff's nicht.
Kannst Du bitte helfen ?
Gruß
robert
https://www.herber.de/bbs/user/79971.xls
AW: @Sepp-bitte um Hilfe-dein Makro
28.04.2012 22:01:40
fcs
Hallo Robert,
das FileSearch-Objekt gibt es nicht mehr, ob der Parameter 5 im Filescripting-Objekt auch funktioniert weiss ich nicht.
Du kannst aber in deiner Hauptprozezur eine entsprechende Datumsprüfung einfügen und die entsprechenden Array-Zeilen leer lassen und nach dem Eintragen der Werte die Leerzeilen löschen.
Gruß
Franz
Sub listFiles()
Dim objFiles() As Object
Dim lngRet As Long, lngIndex As Long
Dim strPath As String
Dim vntValues() As Variant
strPath = fncBrowseForFolder
If strPath <> "" Then
lngRet = FileSearchINFO(objFiles, strPath)
If lngRet > 0 Then
ReDim vntValues(lngRet - 1, 3)
For lngIndex = 0 To lngRet - 1
'Prüfen, ob Datei im vorherigen Monat geändert wurde
If Month(objFiles(lngIndex).DateLastModified) = Month(DateSerial(Year(Date), Month(Date),  _
0)) Then
vntValues(lngIndex, 0) = objFiles(lngIndex).Name
vntValues(lngIndex, 1) = objFiles(lngIndex).Type
vntValues(lngIndex, 2) = objFiles(lngIndex).DateCreated
vntValues(lngIndex, 3) = objFiles(lngIndex).DateLastModified
End If
Next
End If
With Sheets("Tabelle1")
lngIndex = .Cells.SpecialCells(xlCellTypeLastCell).Row
If .Cells.SpecialCells(xlCellTypeLastCell).Row >= 2 Then
.Range("A2:D" & lngIndex).ClearContents
End If
.Range("A2").Resize(lngRet, 4) = vntValues
lngIndex = .Cells(.Rows.Count, 1).End(xlUp).Row
If lngIndex > 2 Then
'leere Zeilen löschen
If Application.WorksheetFunction.CountBlank(.Range(.Cells(2, 2), .Cells(lngIndex, 1))) >  _
0 Then
.Range(.Cells(2, 2), .Cells(lngIndex, 1)).SpecialCells(xlCellTypeBlanks).EntireRow. _
Delete
End If
End If
.Columns("A:D").AutoFit
End With
End If
End Sub

Anzeige
AW: @Sepp-bitte um Hilfe-dein Makro
29.04.2012 08:41:59
robert
Hallo Franz,
zuerst mal danke für Deinen Vorschlag.
Das mit Filesearch ist mir bewusst, aber was ich versucht habe ist, die Parameter 0 bis 6
aus einer 2003 Datei in einer 2010 Datei als Suchkriterium zu verwenden-wenn geht ;-)
und eben das schaffe ich nicht.
Gruß
robert
AW: @Sepp-bitte um Hilfe-dein Makro
29.04.2012 08:52:06
Hajo_Zi
Hallo Robert,
Du glaubst Frantz nicht, das FileSearch-Objekt in 2010 nicht mehr gibt. Da kannst Du ihm aber glauben. Somit hast Du auch keine Change FileSearch-Objekt einzubinden.

AW: @Sepp-bitte um Hilfe-dein Makro
29.04.2012 08:52:09
Hajo_Zi
Hallo Robert,
Du glaubst Frantz nicht, das FileSearch-Objekt in 2010 nicht mehr gibt. Da kannst Du ihm aber glauben. Somit hast Du auch keine Change FileSearch-Objekt einzubinden.

Anzeige
AW: @Sepp-bitte um Hilfe-dein Makro
29.04.2012 09:19:00
robert
Hallo Hajo,
ich versteh Dich nicht- wo in welcher Zeile hast Du gelesen, dass ich Franz NICHT glaube?
Mein Problem ist:
ich habe eine 2003 Datei, wo ich mit FileSearch Kennzeichen LastModified o bis 6
nach täglich, gestern, Vorwoche, Vormonat usw... Datein auflisten kann.
Von Sepp habe ich eine Datei 2010 natürlich ohne FileSearch und dazu war meine
Frage, ob und wie ich diese Kennzeichen in Excel 2010 abfragen kann.
Gruß
robert
AW: @Sepp-bitte um Hilfe-dein Makro
29.04.2012 09:24:59
Hajo_Zi
Hallo Robert,
Das mit Filesearch ist mir bewusst, aber was ich versucht habe ist, die Parameter 0 bis 6
aus einer 2003 Datei in einer 2010 Datei als Suchkriterium zu verwenden-wenn geht ;-)
wenn es geht und es gehtb nicht. Das hatte Franzb auch geschrieben. Ich Antworte nur damirt der Beitrag aus offen ist es wurde ja eine Lösung viorgeschlagen.
Falls Du Filesearch in 2010 eingebunden hast solltestv Du das unbedingt im Forum mitteilen.
Gruß Hajo
Anzeige
AW: @Sepp-bitte um Hilfe-dein Makro
29.04.2012 09:43:47
robert
ob der Parameter 5 im Filescripting-Objekt auch funktioniert weiss ich nicht.

also Hajo, was steht da?
Nicht es geht nicht, sondern er weiss es nicht.
Bitte nicht aus Jux und Tollerei antworten ;-)
Die Suchdatei von Sepp listet mir die Datein aus Excel 2010 ja auf-
was ich wissen will, ob jemand diese Parameter in dem Makro einbauen kann,
damit man die Suche, wie im Excel 2003 Makro, eingrenzen kann.
Gruß
robert
Gruß
robert
AW: @Sepp-bitte um Hilfe-dein Makro
29.04.2012 09:48:31
Hajo_Zi
Hallo Robert,
Bitte genau löesen.
das FileSearch-Objekt gibt es nicht mehr, ob der Parameter 5 im Filescripting-Objekt auch  _
funktioniert weiss ich nicht.

Das FileSearch-Objekt gibt es nicht mehr das hat er nicht als vermutung geschrieben.
Ob das Filescripting-Objekt den Schalter 5 und 6 hat weiss er nicht.
Ich hätte vermutet das der Code von Franz Deine aufgabe erfüllt. Das habe ich nicht getestet.
Ich bae nur geschrieben da Du das FileSearch-Objekt in 2010 einsetzen wolltest. So habe ich das aus Deinem Beitrag gelesen.
Ich mache jetzt Schluss.
Gruß Hajo
Anzeige
Trotz Hajo, Frage bzw.Problem noch offen
29.04.2012 09:51:28
robert
AW: Trotz Hajo, Frage bzw.Problem noch offen
29.04.2012 12:42:41
Gerd L
Hallo Robert,
DateLasteModified ist beim FSO kein Suchparameter, sondern eine Eigenschaft zum Auslesen.
Gruß Gerd
Bitte in die Datei schauen-nur ein Bild..
29.04.2012 13:03:04
robert
https://www.herber.de/bbs/user/79992.xls
Hi,
meine Frage nocheinmal:
kann man noch dieser Auswahl mit einem Filesearch-"Ersatzmakro" Dateien auflisten?
Gruß
robert
AW: Bitte in die Datei schauen-nur ein Bild..
29.04.2012 13:35:48
Tino
Hallo,
hier mal eine Variante zum testen.
kommt als Code in Modul1
Option Explicit 
 
Sub Start() 
Dim strFolder$, sString$, FileFilter$ 
Dim nCount As Long, lngFilecount As Long 
Dim ArrayData(), ArFileFilter() 
  
  
With Tabelle1 
    .UsedRange.EntireRow.Delete 
      
    ArFileFilter = Array("*.pdf", "*.jpg", "*.msg", "*.xls") 'Filter für die Suche 
      
    strFolder = "D:\" 'Suchordner 
      
    If strFolder <> "" Then 
        strFolder = IIf(Right$(strFolder, 1) = "\", strFolder, strFolder & "\") 
        'Parameter 
        'Array, Ordner-Pfad, Counter, Filter, [Subfolder = False], [Änderungsdatum = enuLastModifiedAnyTime] 
         
        ' alle          = enuLastModifiedAnyTime 
        ' Letzter Monat = enuLastModifiedLastMonth 
        ' Letzte Woche  = enuLastModifiedLastWeek 
        ' Dieser Monat  = enuLastModifiedThisMonth 
        ' Diese Woche   = enuLastModifiedThisWeek 
        ' heute         = enuLastModifiedToday 
        ' gestern       = enuLastModifiedYesterday 
         
        FindFiles ArrayData, strFolder, lngFilecount, ArFileFilter, True, enuLastModifiedThisMonth 
        If lngFilecount > 0 Then Transponieren ArrayData 
    End If 
      
    If lngFilecount > 0 Then 
        'Daten einfügen ab A1, Zeile 1 = Überschrift 
        With .Range("A1").Resize(Ubound(ArrayData) + 1, Ubound(ArrayData, 2)) 
            'Überschrift 
            .Cells(1, 1) = "File" 
            .Cells(1, 2) = "Erstellt" 
            .Cells(1, 3) = "Letzte Änderung" 
            .Cells(1, 4) = "Letzter Zugriff" 
            .Rows(1).Font.Bold = True 
            'Daten 
            .Range(.Rows(2), .Rows(.Rows.Count)).Value = ArrayData 
            .EntireColumn.AutoFit 
        End With 
    End If 
End With 
Erase ArrayData 
End Sub 
kommt als Code in Modul2
Option Explicit 
Option Private Module 
'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 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 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 
 
Enum LastModified 
    enuLastModifiedAnyTime 
    enuLastModifiedLastMonth 
    enuLastModifiedLastWeek 
    enuLastModifiedThisMonth 
    enuLastModifiedThisWeek 
    enuLastModifiedToday 
    enuLastModifiedYesterday 
End Enum 
 
Dim Fso As Object 
Sub FindFiles(ArrayData(), ByVal strFolderPath As String, _
        ByRef lngFilecount As Long, ArFileFilter, Optional SubFolder As Boolean = True, Optional ModifiedDate As LastModified = enuLastModifiedAnyTime) 
 
Dim WFD As WIN32_FIND_DATA, lngSearch As Long, strDirName As String 
 
Set Fso = CreateObject("Scripting.FileSystemObject") 
 
lngSearch = FindFirstFile(strFolderPath & "*.*", WFD) 
  
If lngSearch <> INVALID_HANDLE_VALUE Then 
    GetFilesInFolder ArrayData, strFolderPath, lngFilecount, ArFileFilter, ModifiedDate 
    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, SubFolder, ModifiedDate 
        End If 
    Loop While FindNextFile(lngSearch, WFD) 
    FindClose lngSearch 
End If 
Set Fso = Nothing 
End Sub 
  
Sub GetFilesInFolder(ArrayData(), ByVal strFolderPath As String, ByRef lngFilecount As Long, ArFileFilter, Optional ModifiedDate As LastModified = -1) 
Dim WFD As WIN32_FIND_DATA, lngSearch As Long, strFileName As String 
Dim FileFilter, F1 As Object 
  
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 = strFolderPath & Left$(WFD.cFileName, InStr(WFD.cFileName, Chr(0)) - 1) 
                Set F1 = Fso.GetFile(strFileName) 
                     If CheckModified(F1.DateLastModified, ModifiedDate) Then 
                        lngFilecount = lngFilecount + 1 
                        Redim Preserve ArrayData(1 To 4, 1 To lngFilecount) 
                        ArrayData(1, lngFilecount) = strFileName 
                        ArrayData(2, lngFilecount) = F1.DateCreated 
                        ArrayData(3, lngFilecount) = F1.DateLastModified 
                        ArrayData(4, lngFilecount) = F1.DateLastAccessed 
                     End If 
             End If 
             
        Loop While FindNextFile(lngSearch, WFD) 
        FindClose lngSearch 
    End If 
Next 
End Sub 
  
Function CheckModified(ByVal Datum, ModifiedDate As LastModified) As Boolean 
Dim tmpDate As Date 
Datum = CDate(Fix(Datum)) 
Select Case ModifiedDate 
   Case enuLastModifiedAnyTime 
        CheckModified = True 
   Case enuLastModifiedLastMonth 
        CheckModified = (Datum >= DateSerial(Year(Date), Month(Date) - 1, 1)) And (Datum <= DateSerial(Year(Date), Month(Date), 1) - 1) 
   Case enuLastModifiedLastWeek 
        tmpDate = Date - (Weekday(Date, 2) - 1) - 7 
        CheckModified = (Datum >= tmpDate) And (Datum <= tmpDate + 6) 
   Case enuLastModifiedThisMonth 
        CheckModified = (Datum >= DateSerial(Year(Date), Month(Date), 1)) And (Datum <= DateSerial(Year(Date), Month(Date) + 1, 1) - 1) 
   Case enuLastModifiedThisWeek 
        tmpDate = Date - (Weekday(Date, 2) - 1) 
        CheckModified = (Datum >= tmpDate) And (Datum <= tmpDate + 6) 
   Case enuLastModifiedToday 
        CheckModified = Datum = Date 
   Case enuLastModifiedYesterday 
        CheckModified = Datum = Date - 1 
End Select 
End Function 
 
Sub Transponieren(ByRef varArray) 
Dim n&, nn& 
Dim NewArray() 
Redim Preserve NewArray(Lbound(varArray, 2) To Ubound(varArray, 2), Lbound(varArray) To Ubound(varArray)) 
For n = Lbound(varArray, 2) To Ubound(varArray, 2) 
    For nn = Lbound(varArray) To Ubound(varArray) 
        NewArray(n, nn) = varArray(nn, n) 
    Next nn 
Next n 
 
varArray = NewArray 
End Sub 
 
 
Gruß Tino
Anzeige
Nachfrage an Tino..
29.04.2012 14:17:38
robert
Hi Tino,
läuft für Änderung-Monat April super, aber wo muss ich im Code
eine andere Suchfunktion eintragen-zB. LastWeek ?
Gruß
robert
AW: Nachfrage an Tino..
29.04.2012 14:26:08
Tino
Hallo,
an dieser Stelle in Sub Start().
FindFiles ArrayData, strFolder, lngFilecount, ArFileFilter, True, enuLastModifiedLastWeek
Gruß Tino
Danke Tino, funkt ;-)) owT
29.04.2012 14:37:56
robert

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige