作者：绿色风
分类：
时间：2022-08-18
浏览：97
楼主
xmyjk |
Q:依据单元格A列的查询号（即文件名），在工作簿的文件夹下，查找子文件夹，甚至孙文件夹，曾孙文件夹下的该文件，
并把需要的内容读取到B至D列的相应位置（不打开工作薄），找不到则提示无。
A:- Option Explicit
- Sub test()
- Dim fso, fld As Folder, strpath As String, i%, nm, p&, flnm As String, a As String, j&
- Set fso = CreateObject("scripting.filesystemobject") '创建文件系统
- strpath = ThisWorkbook.Path & "\" '设置查找的根路径为本工作簿的所在位置
- For p = 2 To Cells(Rows.Count, 1).End(3).Row '从第二行历遍工作表的A列
- Set fld = fso.GetFolder(strpath) '获取所设定的根目录所在的文件夹
- flnm = Cells(p, 1) & ".xls"
-
- nm = searchfiles(fld, flnm) '将根目录文件夹和需查询的文件名给予自定义函数，进行查找，并返回查找到的文件的路径
-
- If nm <> "" Then '如找到该文件，则如下操作
- a = "'" & nm & "[" & Cells(p, 1) & ".xls]sheet1'!" '按公式的形式，将路径赋予变量a
- For j = 0 To 2
- With Cells(p, 2 + j)
- .FormulaR1C1 = "=" & a & "r" & 5 + j & "c5" '使用公式，在不打开工作薄的情况下，将数据导入
- .Value = .Value '把值赋予单元格，避免公式形式存在容易故障
- End With
- Next
- Else
- Cells(p, 2) = "无" '找不到返回无
- End If
- Next
- End Sub
- Function searchfiles(ByVal fld As Folder, flnm As String)
- Dim fil As File, strpath As String, sfd As Folder, flpth
- Dim fso
- Set fso = CreateObject("scripting.filesystemobject") '创建文件系统
- If fso.fileexists(fld.Path & "\" & flnm) Then '测试所设置的根目录是否存在要查找的文件
- flpth = fld.Path '如果查到，则将找到文件的路径赋给变量
- searchfiles = flpth & "\": Exit Function '返回找到的文件路径，退出函数
- End If
- If fld.SubFolders.Count = 0 Then Exit Function '如果根目录没有存在子文件夹，则退出
- For Each sfd In fld.SubFolders '历遍根目录下的子文件夹
- searchfiles = searchfiles(sfd, flnm) '按递归的形式，继续调用自身，查找后续的文件夹
- If searchfiles <> "" Then Exit Function '如果找到则退出查找函数
- Next
- End Function
 exl.rar
|
2楼
herelazy |
学习啦，谢谢分享！ |
3楼
千年一梦遥 |
虽然看不懂,但感觉是个好东东! |
免责声明
有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素，
经与ExcelTip.Net站长Apolloh商议并征得其同意，
现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示，
供有需要的人士查询使用，也慰缅曾经的论坛时代。
所示各个帖子的原作者如对版权有异议，
可与本人沟通提出，或于本站点留言，我们会尽快处理。
在此，感谢ExcelTip.Net站长Apolloh的支持，感谢本站点所有人**绿色风（QQ:79664738)**的支持与奉献，特此鸣谢！
------本人网名**KevinChengCW（QQ:1210618015)**原ExcelTip.Net总版主之一