Office中国论坛/Access中国论坛

标题: 文件管理与超链接——从“To be, or not to be ”谈起 [打印本页]
作者: roych    时间: 2018-9-19 15:37
标题: 文件管理与超链接——从“To be, or not to be ”谈起
       前两天，版友adouleonshaw在Excel VBA专区发帖，按需求来看，大约是希望能够按要求搜索到文件，如果有则想办法打开，如果不存在则表示不存在。说到这里，忽然想起《哈姆雷特》里的一句经典语句：To be, or not to be , that is the question .国内一般翻译为“存在还是毁灭，这是个问题。”
[attach]62805[/attach]

       这句话用在这里实在是太对了。这个文件，存在还是不存在，判断起来，确实是个问题啊。搜索文件，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

  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
复制代码
     剩下的见附件吧。[attach]62807[/attach]      最后还是那一句，注意文件夹管理。太多文件夹的话，无论怎么处理，都不会快到哪里去

作者: zhengjialon    时间: 2018-9-19 15:55
妙用超链接，好思路
作者: tmtony    时间: 2018-9-20 16:14
点赞！
作者: adouleonshaw    时间: 2018-9-27 10:04
谢谢，老师
作者: cheshirekitten    时间: 2022-3-15 10:25
十分感谢，正在处理文件管理这部分，怎么都搞不来
作者: worryd1    时间: 2023-11-13 21:18
感谢分享，非常不错



欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/) Powered by Discuz! X3.3