获取指定文件夹及其子文件夹下所有文件信息、并做成超链接

ivccav

shi7361 发表于 2018-1-13 10:57
用代码也行吧？参照文件在前一列出现了，用代码读取一下文件不可以么？我是这么想的

自定义一个函数:=getdate(B8,1)
1表示创建日期，2表示修改日期


Function getdate(rng As Range, dt As Integer)
    fn = rng.Hyperlinks(1).Address
    With CreateObject("scripting.filesystemobject")
        Set f = .GetFile(fn)
        If dt = 1 Then
            getdate = Format(f.DateCreated, "yyyy/mm/dd hh:mm:ss")
        Else
            getdate = Format(f.DateLastModified, "yyyy/mm/dd hh:mm:ss")
        End If
    End With
End Function

ivccav

lihuan_ 发表于 2018-1-13 12:06
楼主，问个问题怎么把文件所在的文件夹名称提取出来然后做个路径？做在后面路径后G列呢？

Cells(Rows.C ...

Cells(Rows.Count, 7).End(3).Offset(1)=Left(f.Path, InStrRev(f.Path, "\", -1, 1))

ivccav

shi7361 发表于 2018-1-13 10:54
如果我的单元格已经通过公式插入了超链接，如何在后面的单元格查找到超链接文件的创建和更新时间？谢谢

已看到你的问题，跟你在这里描述的不一样。已按你的要求写好代码，在附件中。


新建文件夹.zip (22.54 KB, 下载次数: 199)

2018-1-13 14:06 上传

点击文件名下载附件

Sub getproperty()
    Dim r&, c As Range
    r = Range("a" & Rows.Count).End(3).Row
    For Each c In Range("a2:a" & r)
        With CreateObject("scripting.filesystemobject")
            If c.Hyperlinks.Count Then
                Set f = .GetFile(c.Hyperlinks(1).Address)
                c.Offset(, 1) = Format(f.Size / 1048576, "0.00MB")
                c.Offset(, 2) = Mid(f.Name, InStrRev(f.Name, ".", -1, 1) + 1)
                c.Offset(, 3) = f.DateCreated
                c.Offset(, 4) = f.DateLastModified
            End If
        End With
    Next
    Range("a2:e" & r).Sort [e2], xlDescending, , , , , , xlNo
End Sub

anymole

2016不能运行。。

ivccav

anymole 发表于 2018-1-13 18:20
2016不能运行。。

显示这个窗体只是装饰，对程序功能没有任何影响。
你直接在程序中移除有关该窗体的部分就行了。
（下面3句红色部分）

Sub allfiles()

    Set fdo = Application.FileDialog(msoFileDialogFolderPicker)
    If fdo.Show = -1 Then
        pth = fdo.SelectedItems(1)
    Else
        MsgBox "您没有选择文件夹！按『确定』键结束", vbCritical
        Exit Sub
    End If
    UserForm1.Show 0
    DoEvents
    Application.ScreenUpdating = False
    With ActiveSheet
        .UsedRange.Clear
        .Cells(1, 1) = "文件序号"
        .Cells(1, 2) = "文件名称"
        .Cells(1, 3) = "创建日期"
        .Cells(1, 4) = "修改日期"
        .Cells(1, 5) = "文件类型"
        .Cells(1, 6) = "文件大小"
        Getfd (pth)

        r = .Range("b" & Rows.Count).End(3).Row
        For Each c In .Range("b2:b" & r)
            .Hyperlinks.Add Anchor:=c, Address:=c.Value, TextToDisplay _
            :=Split(c, "\")(UBound(Split(c, "\")))
        Next
        .Range("a1:f" & r).Borders.LineStyle = xlContinuous
        .Range("a1:f" & r).Borders.Weight = xlThin
    End With
    Application.ScreenUpdating = True
    Unload UserForm1
    MsgBox "文件已全部获取！点『确定』键结束"
End Sub

lihuan_

非常感谢楼主的分享，学习了！
有两个问题需要请教：
1.B列的数据当中我只需要.PDF或者.excel后缀的文件。其它格式的不要怎么操作呢？
2.需要在H列只显示第一级文件夹名称，I列显示H列下级文件夹名称，J列显示I列下级文件夹名称。
这些能直接点开路径。
感激不尽！

ivccav

lihuan_ 发表于 2018-1-14 10:54
非常感谢楼主的分享，学习了！
有两个问题需要请教：
1.B列的数据当中我只需要.PDF或者.excel后缀的文件 ...

筛选只是PDF和XLS的文件可以有，逐级显示文件夹路径没有意义，只写了一个筛选文件类型的，并显示该文件所在的文件夹。
想显示每一级文件夹，可以自己用split获取，按“\”分割然后循环就行了，在该程序中，获取最后一列可以用cells(r,columns.count).end(xltoleft).column，其中r是最后一行行号。
获取指定文件夹及其子文件夹下所有文件 副本.zip (26.9 KB, 下载次数: 434)

2018-1-14 16:29 上传

点击文件名下载附件

Sub allfiles()
   
    Set fdo = Application.FileDialog(msoFileDialogFolderPicker)
    If fdo.Show = -1 Then
        pth = fdo.SelectedItems(1)
    Else
        MsgBox "您没有选择文件夹！按『确定』键结束", vbCritical
        Exit Sub
    End If
    UserForm1.Show 0
    DoEvents
    Application.ScreenUpdating = False
    With ActiveSheet
        .UsedRange.Clear
        .Cells(1, 1) = "文件序号"
        .Cells(1, 2) = "文件名称"
        .Cells(1, 3) = "创建日期"
        .Cells(1, 4) = "修改日期"
        .Cells(1, 5) = "文件类型"
        .Cells(1, 6) = "文件大小"
        .Cells(1, 7) = "文件路径"
        Getfd (pth)
   
        r = .Range("b" & Rows.Count).End(3).Row
        .Range("a1:f" & r).Borders.LineStyle = xlContinuous
        .Range("a1:f" & r).Borders.Weight = xlThin
    End With
    Application.ScreenUpdating = True
    Unload UserForm1
    MsgBox "文件已全部获取！点『确定』键结束"
End Sub
Sub Getfd(ByVal pth)
    Set fso = CreateObject("scripting.filesystemobject")
    Set ff = fso.getfolder(pth)
    i = 1
    For Each f In ff.Files
        If InStr("PDF/XLS", UCase(Mid(f.Name, InStrRev(f.Name, ".", -1, 1) + 1))) Then
            r = Cells(Rows.Count, 1).End(3).Offset(1).Row
            Cells(r, 1) = i: i = i + 1
            With Cells(r, 2)
                .Value = f
                .Hyperlinks.Add Anchor:=Cells(r, 2), Address:=.Value, TextToDisplay:=Split(.Value, "\")(UBound(Split(.Value, "\")))
            End With
            Cells(r, 3) = f.DateCreated
            Cells(r, 4) = f.DateLastModified
            Cells(r, 5) = Mid(f.Name, InStrRev(f.Name, ".", -1, 1) + 1)
            Cells(r, 6) = Format(f.Size / 1048576, "0.00MB")
            With Cells(r, 7)
                .Value = ff.Path
                .Hyperlinks.Add Anchor:=Cells(r, 7), Address:=.Value, TextToDisplay:=.Value
            End With
        End If
    Next
    For Each fd In ff.subfolders
        Getfd (fd)
    Next
End Sub

lihuan_

ivccav 发表于 2018-1-14 16:35
筛选只是PDF和XLS的文件可以有，逐级显示文件夹路径没有意义，只写了一个筛选文件类型的，并显示该文件所 ...

很实用，学习了。谢谢你！！

jjmysjg

留下记号，谢谢楼主

rio123

ivccav 发表于 2018-1-14 16:35
筛选只是PDF和XLS的文件可以有，逐级显示文件夹路径没有意义，只写了一个筛选文件类型的，并显示该文件所 ...

你好，为什么我用这个在获取下一级带文件夹的文件时，会提示错误？有的文件夹无法提取，见下图