Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Datum der zu importierenden Datei ermitteln
#1
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.

Code:
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
Antworten Top
#2
Hier geht es weiter:
http://www.ms-office-forum.net/forum/sho...ost1683218

(Dort sind auch bereits Lösungen)

Gruß Ralf
Gib einem Mann einen Fisch und du ernährst ihn für einen Tag. 
Lehre einen Mann zu fischen und du ernährst ihn für sein Leben. (Konfuzius)
[-] Folgende(r) 1 Nutzer sagt Danke an RPP63 für diesen Beitrag:
  • volkswirt87
Antworten Top
#3
Hallöchen,

danke, Ralf ... dann müssen wir uns ja nicht weiter abmühen.

Damit aber spätere Hilfesuchende und hier Gestrandete nicht frustriert sind, hier zumindest eine Teillösung:


Code:
Sub DateiInfosErmitteln()
Dim fs As Object
Dim f As Object
Dim strDatei As String
 
 strDatei = ActiveWorkbook.FullName
 Set fs = CreateObject("Scripting.FileSystemObject")
 Set f = fs.GetFile(strDatei)
 
 MsgBox _
"Erstellungsdatum: " & vbTab & f.DateCreated & vbLf & _
"Letzter Zugriff: " & vbTab & f.DateLastAccessed & _
 vbLf & "Letzte Änderung: " & vbTab & _
 f.DateLastModified, vbInformation
End Sub
________________________________________________________________________
wer aufgibt, ohne es versucht zu haben, gibt einfach nur auf!

Grüße aus Norderstedt, Peter
[-] Folgende(r) 1 Nutzer sagt Danke an Käpt'n Blaubär für diesen Beitrag:
  • volkswirt87
Antworten Top
#4
Hola,

oder auch.....

http://www.herber.de/forum/messages/1436362.html

Gruß,
steve1da
[-] Folgende(r) 1 Nutzer sagt Danke an steve1da für diesen Beitrag:
  • volkswirt87
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste