EXCEL VBA 获取文件夹及子文件夹下所有文件并建立超链接

具体怎么做啊~我有很多文件夹 子文件夹 在网上看到了VBA的代码 求高手给讲讲具体怎么做 想做个目录方便一点

还没有解决吗?那我就来试一下。

(1)首先,楼主先新建一个excel,名称楼主自己写,怎样都行,然后将其打开。

(2)打开后按住Alt再按F11,这样就会打开vba代码编辑器

(3)点菜单栏上的“插入”,选择“模块”,这样在左下角就会出现一个“模块1”

(4)双击“模块1”,右边就会出现“模块1”的编辑界面,将以下代码复制,并粘贴到这个界面中,按F5运行。

Sub 遍历文件夹()
'Columns(1).Delete  
On Error Resume Next
Dim f As String
Dim file() As String
Dim i, k, x
x = 1
i = 1: k = 1
ReDim file(1 To i)
file(1) = InputBox("请输入要查找的文件夹:") & "\"
Do Until i > k
    f = Dir(file(i), vbDirectory)
        Do Until f = ""
            If InStr(f, ".") = 0 Then
                k = k + 1
                ReDim Preserve file(1 To k)
                file(k) = file(i) & f & "\"
            End If
            f = Dir
        Loop
    i = i + 1
Loop
For i = 1 To k
    f = Dir(file(i) & "*.*")
    Do Until f = ""
       'Range("a" & x) = f
       Range("a" & x).Hyperlinks.Add Anchor:=Range("a" & x), Address:= _
        file(i) & f, TextToDisplay:=f
        x = x + 1
        f = Dir
    Loop
Next
End Sub

(5)在出现的对话框中,将你要查找的文件的地址复制到对话框中,按确定,就完成了。

 

注:这里用的是excel2007版,如果楼主用的是其他版本,有可能存在代码不兼容问题。

 

图1.打开vba编辑器。

 

图2.运行代码。

 

图3.结果。

温馨提示:答案为网友推荐,仅供参考
第1个回答  推荐于2016-05-08
代码实现重新构建所有链接,如果要单独刷新某文件夹的文件链接,可仿效代码(可不用单独刷新,如有增删,重新全部构建)。
Sub test()
Dim fso, fp, ar, ar1, subf, f, n%, m%, i%, j%, c As Range
Sheets("6月").Activate
ActiveSheet.UsedRange.Offset(2) = ""
Set fso = CreateObject("scripting.filesystemobject")
Set fp = fso.getfolder(ThisWorkbook.Path).subfolders
ReDim ar(1 To fp.Count)
For Each subf In fp
n = n + 1
If subf.Files.Count <> 0 Then
ReDim ar1(1 To subf.Files.Count)
m = 0
For Each f In subf.Files
m = m + 1
ar1(m) = f & "|" & fso.getbasename(subf) & "|" & fso.getbasename(f)
Next
ar(n) = ar1
End If
Next
For i = 1 To UBound(ar)
If IsArray(ar(i)) Then
Set c = Rows(1).Find(Split(ar(i)(1), "|")(1))
If Not c Is Nothing Then
For j = 1 To UBound(ar(i))
With c.End(xlDown)
.Offset(1).Value = Split(ar(i)(j), "|")(2)
ActiveSheet.Hyperlinks.Add Anchor:=.Offset(1), Address:=Split(ar(i)(j), "|")(0)
End With
Next
End If
End If
Next
Set fso = Nothing
End Sub
第2个回答  2014-01-04
用fso。我前一阵刚做了一个。不过代码没在这。你可以找一段代码,不懂得地方我给你注释
第3个回答  2014-01-04
ALT+F11打开VBE编辑界面 创建一个新模块 录入下载的代码