文件管理与超链接——从“To be, or not to be ”谈起

roych

       前两天，版友adouleonshaw在Excel VBA专区发帖，按需求来看，大约是希望能够按要求搜索到文件，如果有则想办法打开，如果不存在则表示不存在。说到这里，忽然想起《哈姆雷特》里的一句经典语句：To be, or not to be , that is the question .国内一般翻译为“存在还是毁灭，这是个问题。”

       这句话用在这里实在是太对了。这个文件，存在还是不存在，判断起来，确实是个问题啊。搜索文件，VBA不是不可以，只是处理起来有些繁琐，需要先在目录下搜索（如果根目录下存在其他文件的话），然后再根目录下各个子文件夹搜索……如果多级文件夹，就更不用说了。幸亏这个例子相对简单，没出现上述的麻烦，只需要在根目录下各个子文件夹搜索即可。
       搜索比较简单，用FileSystemObject各种GetFold和GetFile就好了。那么怎么处理打开文件的操作呢？我一开始是用超链接的思路来实现的。事实上，这应该也是相对简单的操作，如果非要在原先的文件名所在的单元格上处理，则需要写两部分代码。一部分返回“是否存在文件”，另一部分则在指定单元格上增加selection_change事件或者click事件（后者可能需要使用With Event语句）。
       思路理清之后，剩下的就是写脚本了。考虑到需要返回值，所以就写成了自定义函数，返回字符串。不过后来版友adouleonshaw发觉，用函数执行起来很卡。也难怪，500行，每行需要嵌套循环，每次打开都会运算。于是再稍稍改了下，用VBA转为值。这样只需执行一次即可。

      主函数如下：

1. Sub 按钮1_Click()
   
2.     Dim rng As Range
   
3.     Dim i As Long
   
4.     Dim strPath As String
   
5.     For i = 1 To 10
   
6. '请自行根据需要改动单元格位置。
   
7.         strPath = isExists(Sheet1.Range("B1").Offset(i, 0))
   
8. '使用公式的话可以用这一句，if部分注释掉即可。
   
9.         'Sheet1.Range("E1").Offset(i, 0).Formula = "=if(len(""" & strPath & """)>0,HYPERLINK(""" & strPath & """,""有""),""无"")"
   
10.         If Len(strPath) > 0 Then
    
11. 
    
12.             Sheet1.Range("E1").Offset(i, 0) = "无"
    
13.         Else
    
14.             Sheet1.Hyperlinks.Add anchor:=Sheet1.Range("E1").Offset(i, 0), Address:="""" & strPath & """", TextToDisplay:="有"
    
15.         End If
    
16.     Next
    
17. End Sub

复制代码

      调用函数如下：

1. Function isExists(ByVal rng As Range, Optional ByVal strExtName As String = ".pdf") As String
   
2.     Dim fso As New FileSystemObject
   
3.     Dim fd As Folder
   
4.     Dim fl As File
   
5.     Dim strFileName As String
   
6.     Dim strExists As String
   
7.     strExists = ""
   
8.     For Each fd In fso.GetFolder(ThisWorkbook.Path).SubFolders
   
9.         For Each fl In fd.Files
   
10.             strFileName = Mid(fl, InStrRev(fl, "") + 1, Len(fl) - InStrRev(fl, "") - Len(strExtName))
    
11.             If rng.Value = strFileName Then
    
12.                 strExists = fl
    
13.                 Exit For
    
14.             End If
    
15.             
    
16.         Next
    
17.     Next
    
18.     isExists = strExists
    
19. End Function

复制代码

     剩下的见附件吧。      最后还是那一句，注意文件夹管理。太多文件夹的话，无论怎么处理，都不会快到哪里去

zhengjialon

妙用超链接，好思路

tmtony

点赞！

adouleonshaw

谢谢，老师

cheshirekitten

十分感谢，正在处理文件管理这部分，怎么都搞不来

worryd1

感谢分享，非常不错