Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 1279|回复: 2

修改代码,得到文件上面4级目录下的所有文件及超链接

[复制链接]
发表于 2013-8-6 08:05 | 显示全部楼层 |阅读模式
下面代码是得到文件夹下的文件名,并加超链接,例如F:\datedept\datahg\数据录入\中国宏观\财政\年数据 文件夹下的MAC505_中国宏观_财政_地方政府性基金收入(年)_录入说明.doc ,并附有超链接。
我想要“数据录入”文件夹下所有文件的文件名和超链接
求大神指教


Sub add_link()
    On Error GoTo err_exit
    Dim fd As FileDialog
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)
    Dim vritem As Variant
    With fd
        If .Show = -1 Then
            i = 0
            For Each vritem In .SelectedItems
                i = i + 1
                dname = vritem
            Next vritem
            If i >= 2 Then
                MsgBox ("不能够选择多个文件夹,请重新选择")
                Exit Sub
            End If
        End If
    End With
    Set fd = Nothing
    dir_name = (dname & "\")
    strfilename = Dir(dir_name)
    J = 0
    n = 2
    Do While strfilename <> ""
        Sheets(1).Cells(n, 1) = strfilename
        Sheets(1).Hyperlinks.Add Anchor:=Sheets(1).Cells(n, 1), Address:=dir_name & strfilename
        n = n + 1
        J = J + 1
        strfilename = Dir
    Loop
err_exit:
    Exit Sub
End Sub
发表于 2013-8-6 08:16 | 显示全部楼层
回复

使用道具 举报

发表于 2013-8-6 09:51 | 显示全部楼层
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-5-6 18:31 , Processed in 0.271398 second(s), 12 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表