[µo°Ý] Àɮ׭קï®É¶¡§ì¥h¤è¦¡½Ð±Ð

rouber590324

dear  all ¤j¤j
1.ªí¤@·|§ì¨ú«ü©waddres¤º¤§ÀÉ®×list
  1.1½Ð±Ð¦p¦ó©ó EÄæ·s¼W§ì¨ú¸ÓÀɮפ§ "­×§ï®É¶¡"
2.·Ð¤£§[½ç±Ð    THANKS*10000

ªí¤@
Sub ¦C¥X©ú²Ó()

[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)  '¶¥¼h¼Æ

    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

­ã´£³¡ªL

FilePath = "D:\T001.TXT"

FDT = FileDateTime(FilePath)
MsgBox FDT '­×§ï¤é´Á®É¶¡

Set xObj = CreateObject("Scripting.FileSystemObject")
Set F = xObj.GetFile(FilePath)
MsgBox F.DateCreated '«Ø¥ß¤é´Á®É¶¡

VBE»¡©úÀÉ¥i¥H§ä¨ì¬ÛÃö»¡©ú!