Filedate aus filesystemobject
LotharP
ich habe ein Makro das mal ursprünglich auf alten Versionen recht gut lief und möchte das nun auf 2007 umstricken.
Das Makro las Fileinfos aus einem bestimmten Verzeichnis ein und gab mir in einer Reihe die gewünschten Informationen.
Ich habe das MAkro soweit umgebaut das ich ein paar Infos einlesen kann, aber einige fehlen einfach und ich weiss nicht weiter:
Usnom = Application.UserName
leer = InStrRev(Usnom, " ", -1) + 1
Usnom = Mid(Usnom, leer, Len(Usnom) - (leer - 1))
Sheets("Inhaltsverzeichnis").Select
VORBELEG = PATHNOM
CALCOFF
Set w = Worksheets("Inhaltsverzeichnis")
If w.AutoFilterMode Then
Cells.AutoFilter
Else
End If
fz = ZET + 3
TABCLEAN (fz)
Verzeichnis = InputBox(("Bitte Pfad eingeben!"), "Verzeichnisse in Tabelle1", VORBELEG)
VORBELEG = Verzeichnis
fz = ZET + 3
For Each aItem In pcurrentdir.Files
SONGNAME = Left(aItem.Name, Len(aItem.Name) - 4)
HYPENAME = VORBELEG & "\" & aItem.Name
ActiveSheet.Hyperlinks.Add Anchor:=Cells(lngAkt + 4, 1), Address:=HYPENAME, TextToDisplay:=SONGNAME
Cells(lngAkt + 4, 2) = VORBELEG
' Cells(lngAkt + 4, 3) = FileDateTime(.FoundFiles.Item(lngAkt))
' Cells(lngAkt + 4, 4) = FileLen(.FoundFiles.Item(lngAkt))
' Cells(lngAkt + 4, 6) = Right((.FoundFiles.Item(lngAkt)), 3)
' Cells(lngAkt + 4, 5) = Right(Mid((.FoundFiles.Item(lngAkt)), 1, InStrRev((.FoundFiles.Item(lngAkt)), "\", InStrRev((.FoundFiles.Item(lngAkt)), "\", -1, vbBinaryCompare), _
' vbBinaryCompare) - 1), Len(Mid((.FoundFiles.Item(lngAkt)), 1, InStrRev((.FoundFiles.Item(lngAkt)), "\", InStrRev((.FoundFiles.Item(lngAkt)), "\", -1, vbBinaryCompare), _
' vbBinaryCompare) - 1)) - InStrRev(Mid((.FoundFiles.Item(lngAkt)), 1, InStrRev((.FoundFiles.Item(lngAkt)), "\", InStrRev((.FoundFiles.Item(lngAkt)), "\", -1, vbBinaryCompare), _
' vbBinaryCompare) - 1), "\", -1, vbBinaryCompare))
lngAkt = lngAkt + 1
Next
Die auskommentierten Zeilen sind die noch fehlenden Informationen.
Es wär nett wenn jemand mal schauen könnte!
Vielen Dank und L.G. aus Köln
Lothar