vba管理自己的文件

605407217

    Excel 的功能真的太强大了，不仅可以管理数据，还可以用来管理你的文件。   大家有没有这种体会——当我们去一家小书店找一本书的时候，总是先找书架上的标签，然后在相应的书架上找书；当我们去一个大型图书馆找一个书的时候，总是先在终端机上查找书名，然后到对应的位置找书。
    当磁盘里文件太多的时候，我们总喜欢用文件夹给它们分类，这样可以方便我们查找。但是文件超级多的时候，翻文件夹都不方便的时候，该如何应对呢？有人会说文件浏览器可以查找文件。对，是查找。可是我今天说的不是用浏览器查找，而是用excel查找。因为excel的查找速度比浏览器快很多。
   excel的查找功能大家都了解吧，了解的人会说“它只能查数据，不能查文件呀”。下面详细介绍如何用excel来查找文件。分为两步：1，为所有的文件建一个目录；2，创建超链接与各个文件关联。
   1，我们可以用表格为所有的文件做一个目录，把所有文件的路径和名称存放的表格中。相信这项工作大家一定都会，但是对于一些人来讲，工程浩大，做起来非常困，简直是本末倒置、舍近求远。
   2，上一步我们已经为所有的文件做好了目录，然后为每一条目录建立一个超链接，链接地址指定对应的文件。觉得上一步非常困难的同学，这一步也会相当的困难。
  历史书里最轻描淡写，却又最触目惊心的一句话是：“我们走了一些弯路……” 不要再说：“成功是没有捷径的” 我们已经被欺骗过无数次了。那么捷径何在？待我缓缓道来。
    下面是VBA代码：

‘提取所有子文件夹路径

Sub FsoGetFolderList()

Dim rowIndex As Integer, mypath As String, wjj As Object

rowIndex = 1

mypath = ThisWorkbook.Path

Set wjj = Application.FileDialog(msoFileDialogFolderPicker)

wjj.Show

mypath = wjj.SelectedItems(1)

Do

    If rowIndex = 1 Then

        GetFolderPath (mypath)

        Cells(rowIndex, 1).Value = mypath

    Else

        GetFolderPath (Cells(rowIndex, 1).Value)

    End If

    rowIndex = rowIndex + 1

Loop Until Cells(rowIndex, 1).Value = ""

End Sub

Function GetFolderPath(mainFolderPath)

Dim mainFolder As Object, childFolders As Object, childfolder As Object

Dim index As Integer

Dim fso As New FileSystemObject

Set mainFolder = fso.GetFolder(mainFolderPath)

Set childFolders = mainFolder.SubFolders

index = Cells(4 ^ 8, 1).End(xlUp).Row + 1

For Each childfolder In childFolders

    Cells(index, 1).Value = childfolder.Path

    index = index + 1

Next

Set fso = Nothing

Set mainFolder = Nothing

Set childFolders = Nothing

Set childfolder = Nothing

End Function

‘提取对应文件夹内所有文件名称

Sub fsogetfilelist()

On Error Resume Next

Dim childfile As Object, childfiles As Object, fol As Object

Dim col As Integer, n As Integer, pat As String

Dim fso As New FileSystemObject

Cells.Clear

Call FsoGetFolderList

For n = 1 To Range("a1").End(xlDown).Row

    pat = Cells(n, 1).Value

    Set fol = fso.GetFolder(pat)

    Set childfiles = fol.Files

    col = 2

    For Each childfile In childfiles

        Cells(n, col).Value = childfile.Name

        col = col + 1

    Next

Next

Set childfile = Nothing

Set childfiles = Nothing

Set fol = Nothing

Set fso = Nothing

Columns.AutoFit

End Sub

‘建立超链接

Sub jlclj()

Dim m As Integer, rg As Range, rge As Range, r As Integer, st As String

For r = 1 To Range("a1").End(xlDown).Row

    st = Cells(r, 1).Value

    ActiveSheet.Hyperlinks.Add Cells(r, 1), st

Next r

Set rg = ActiveSheet.UsedRange.Offset(0, 1).SpecialCells(xlCellTypeConstants)

For Each rge In rg

    st = Cells(rge.Row, 1).Value2 & "\" & rge.Value2

    ActiveSheet.Hyperlinks.Add rge, st

Next

Set rg = Nothing: Set rge = Nothing

End Sub

以上是全部VBA代码，运行fsogetfilelis（）完成第1步操作创建目录；运行jlclj()

完成第2步操作建立超链接。

以上两步操作的效果是这样的：

605407217

OFFICE2016

cyanite-63

谢谢分享

谪仙

报错了不知哪里的问题