Datum der zu importierenden Datei ermitteln

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
Bild

Betrifft: Datum der zu importierenden Datei ermitteln
von: volkswirt87
Geschrieben am: 14.07.2015 16:54:21

Liebe Forengemeinde,
ich möchte in Excel die Daten von einem Laufwerk als Hyperlink darstellen.
Mit folgendem Code wird mir auch in der ersten Spalte der Dateiname als Hyperlink und in der zweiten Spalte der zugehörige Dateipfad angezeigt.
Allerdings hätte ich noch gerne, dass in der dritten Spalte das Erstellungsdatum der jeweiligen Datei, in der vierten Spalte das Datum der letzten Änderung der Datei und in der fünften Spalte das Datum des letzten Zugriffs der Datei dargestellt wird.
Wie muss ich hierzu den Code ergänzen bzw. abändern? Bin leider noch Anfänger in Sachen VBA.
Option Explicit

Private strList() As String
Private lngCount As Long
Private sPfad As String


Public Sub DateienAuflisten()
 
Dim i As Long
 
With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
End With
 
OrdnerAuswählen
lngCount = 0
SearchFiles sPfad, "*"
    
If lngCount = 0 Then
    MsgBox "Es wurde in der Ordnerstruktur" & sPfad & " keine Dateien gefunden!"
    Exit Sub
End If
    
With ThisWorkbook
    On Error Resume Next
    .Worksheets("Datei Übersicht").Delete
    On Error GoTo 0
    .Worksheets.Add(After:=Worksheets(ThisWorkbook.Worksheets.Count)).Name = "Datei Übersicht"
End With
 
With ActiveSheet
    .Range(.Cells(1, 1), .Cells(lngCount, 2)) = _
        WorksheetFunction.Transpose(strList)
    .Range(.Cells(1, 2), .Cells(lngCount, 2)).Replace What:=sPfad & "\", Replacement:="", _
       LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
       SearchFormat:=False, ReplaceFormat:=False
   For i = 0 To lngCount - 1
       With .Cells(i + 1, 1)
       .Select
       .Cells(i + 1, 1).Hyperlinks.Add Anchor:=Selection, Address:=strList(1, i), TextToDisplay: _
 _
 _
 _
 _
=strList(0, i)
       End With
   Next i
   .Range("A:A").EntireColumn.AutoFit
   .Rows(1).Insert
   With Range(Cells(1, 1), Cells(1, 2))
       .Value = Array("Datei Name", "Datei Pfad")
       .Font.Bold = True
       .Interior.PatternColorIndex = xlAutomatic
       .Cells.Interior.ThemeColor = xlThemeColorAccent1
   End With
End With
 
With Application
   .ScreenUpdating = False
   .DisplayAlerts = False
End With
 
End Sub


Private Sub OrdnerAuswählen()
   
With Application.FileDialog(msoFileDialogFolderPicker)
   .InitialFileName = Application.DefaultFilePath & " \"
   .Title = "Bitte Ordner wählen"
   .Show
   If .SelectedItems.Count = 0 Then Exit Sub
       sPfad = .SelectedItems(1)
End With
 
End Sub


Private Sub SearchFiles(strFolder As String, strFileName As String)
   Dim objFolder As Object
   Dim objFile As Object
   Dim objFSO As Object
   Set objFSO = CreateObject("Scripting.FileSystemObject")
   For Each objFile In objFSO.GetFolder(strFolder).Files
       If objFile.Name Like strFileName Then
           ReDim Preserve strList(0 To 1, lngCount)
           strList(0, lngCount) = objFile.Name
           strList(1, lngCount) = objFile.Path
           lngCount = lngCount + 1
       End If
   Next
   For Each objFolder In objFSO.GetFolder(strFolder).Subfolders
       SearchFiles strFolder & "\" & objFolder.Name, strFileName
   Next
 
End Sub

Bild

Betrifft: AW: Datum der zu importierenden Datei ermitteln
von: Michael
Geschrieben am: 14.07.2015 17:58:07
Hallo Vw87,
sieh Dir mal das an: http://www.office-loesung.de/ftopic406250_0_0_asc.php
Schöne Grüße,
Michael

Bild

Betrifft: AW: Datum der zu importierenden Datei ermitteln
von: Nepumuk
Geschrieben am: 14.07.2015 18:25:36
Hallo,
an die Daten kommst du so ran:

Private Sub SearchFiles(strFolder As String, strFileName As String)
    Dim objFolder As Object
    Dim objFile As Object
    Dim objFSO As Object
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    For Each objFile In objFSO.GetFolder(strFolder).Files
        If objFile.Name Like strFileName Then
            Redim Preserve strList(0 To 4, lngCount)
            With objFile
                strList(0, lngCount) = .Name
                strList(1, lngCount) = .Path
                strList(2, lngCount) = .DateCreated
                strList(3, lngCount) = .DateLastAccessed
                strList(4, lngCount) = .DateLastModified
                lngCount = lngCount + 1
            End With
        End If
    Next
    For Each objFolder In objFSO.GetFolder(strFolder).Subfolders
        SearchFiles strFolder & "\" & objFolder.Name, strFileName
    Next
End Sub

Du musst nur noch die Ausgabe anpassen.
Gruß
Nepumuk

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Datum der zu importierenden Datei ermitteln"