Hallo zusammen,

ich habe in VBA keinerlei Erfahrung und habe mir meinen aktuellen Code nur durch Copy Paste erschlichen. Nun hänge ich leider an einem Punkt und komme nicht weiter.

Ich lasse mit dem "Programm" aus einem Ordner alle pdf Dateien auslesen. Diese werden in Spalte A angezeigt. Von diesen DAteien hätte ich gerne ab der Zeile 3 in der Spalte G das Erstellungsdatum der Datei. Könnt ihr mir helfen?

'Hyperlinks mit Ordnerauslesen
'Quelle:http://www.office-loesung.de/ftopic60815_30_0_asc.php

Option Explicit
Private strList() As String
Dim varFolder As Variant
Private lngCount As Long
Dim strTMP As String
Public Sub Dateinamen()
            Columns("A:C").EntireColumn.Hidden = True

    lngCount = 0
    'strTMP = GetFolder()
    strTMP = "D:\test" ' so für festen Pfad
    If strTMP = "" Or Left(strTMP, 1) = ":" Then Exit Sub
    SearchFiles strTMP, "*.pdf"
    'SearchFiles strTMP, "*.ppt", True 'so MIT Unterordner
    If Right(strTMP, 1) <> "\" Then strTMP = strTMP & "\"
    If lngCount = 0 Then
        MsgBox "No file found"
        Exit Sub
    End If
    With ThisWorkbook.Worksheets(1)
        .Columns(1).Clear
        .Range(.Cells(3, 1), Cells(lngCount + 2, 1)) = _
            WorksheetFunction.Transpose(strList)
    .Columns("A").AutoFit
    Columns("A:C").EntireColumn.Hidden = True
    End With
    Call Make_Link
    Set varFolder = Nothing
End Sub
Private Function GetFolder() As String
    Dim objShell As Object
    Dim strPath As String
    Set objShell = CreateObject("Shell.Application")
    Set varFolder = objShell.BrowseForFolder(0, "Folder", &H4000, 17)
    If varFolder Is Nothing Then
        Set varFolder = Nothing
        Set objShell = Nothing
        Exit Function
    End If
    GetFolder = varFolder.Self.Path
    Set objShell = Nothing
End Function
Private Sub SearchFiles(strFolder As String, strFileName As String, Optional blnSubFolder As Boolean = False)
    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(lngCount)
            strList(lngCount) = objFile.Name
            lngCount = lngCount + 1
        End If
    Next
    If blnSubFolder = True Then
        For Each objFolder In objFSO.GetFolder(strFolder).Subfolders
            SearchFiles strFolder & "\" & objFolder.Name, strFileName
        Next objFolder
    End If
End Sub
Public Sub Make_Link()
    Dim lngRow As Long
    With ThisWorkbook.Worksheets(1)
        lngRow = .Range("A" & .Rows.Count).End(xlUp).Row
        For lngRow = 2 To lngRow
            .Hyperlinks.Add Anchor:=.Cells(lngRow, 1), _
                Address:=strTMP & .Cells(lngRow, 1)
        Next lngRow
    End With
End Sub

Zurzeit sieht die Datei wie folgt aus:

Danke für eure Hilfe.

Liebe Grüße