標題: [發問] 檔案修改時間抓去方式請教 [打印本頁]

---

作者: rouber590324    時間: 2016-5-20 14:17     標題: 檔案修改時間抓去方式請教

dear  all 大大
1.表一會抓取指定addres內之檔案list
  1.1請教如何於 E欄新增抓取該檔案之 "修改時間"
2.煩不吝賜教    THANKS*10000

表一
Sub 列出明細()

[b1] = ActiveWorkbook.Path

Range([a4], [f65536]).ClearContents

[a4:a65536].EntireRow.Delete

Application.ScreenUpdating = False



Dim fs, fd

Set fs = CreateObject("Scripting.FileSystemObject")

Set fd = fs.GetFolder([b1].Value)  '根目錄

   

FilesHierarchy fd, "x"

Range([a4], Cells([a65536].End(3).Row, 6)).Borders.LineStyle = 1

Range([a4], [a65536].End(3)).RowHeight = 24



Dim cOffset As Long, ar

For r = 4 To [a65536].End(3).Row     '作樹狀圖

    ar = Split(Cells(r, 1), ".")

    cOffset = UBound(ar)  '階層數

    With Cells(r, 8 + cOffset)

        .Value = Cells(r, 3)

        .Interior.ColorIndex = IIf(Cells(r, 2) = "資料夾", 36, xlNone)

        .Borders(xlEdgeBottom).LineStyle = xlContinuous

        .Borders(xlEdgeBottom).Weight = xlThick

        .Borders(xlEdgeLeft).LineStyle = xlContinuous

    End With

   

    If ar(cOffset) <> "x" And ar(cOffset) <> "1" Then

        For i = r - 1 To 4 Step -1

            If Cells(i, 8 + cOffset) <> "" Then Exit For

            Cells(i, 8 + cOffset).Borders(xlEdgeLeft).LineStyle = xlContinuous

        Next

    End If

   

Next

Application.ScreenUpdating = True

End Sub

---

作者: 准提部林    時間: 2016-5-21 13:23

FilePath = "D:\T001.TXT"

FDT = FileDateTime(FilePath)
MsgBox FDT '修改日期時間

Set xObj = CreateObject("Scripting.FileSystemObject")
Set F = xObj.GetFile(FilePath)
MsgBox F.DateCreated '建立日期時間

VBE說明檔可以找到相關說明!

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)