作者：绿色风
分类：
时间：2022-08-17
浏览：132
楼主
kevinchengcw |
Q: 如何用vba代码以列表形式提取收藏夹里的内容到Excel中？
A: 代码如下：- Sub test()
- Dim favPath$, FN$, Str$, Arr, Result, Arrt, N&
- With CreateObject("wscript.shell") '创建WSH对象
- favPath = .specialfolders("Favorites") '提取收藏夹目录路径
- FN = ThisWorkbook.Path & "\temp__.txt" '指定网址快捷方式清单列表全路径名
- .Run Environ("comspec") & " /c dir """ & favPath & "\*.url"" /s/b>""" & FN & """", 0, 1 '提取清单并等待执行完成
- With CreateObject("scripting.filesystemobject").opentextfile(FN) '利用FSO对象读取列表清单
- Str = Trim(.readall)
- .Close
- End With
- Kill FN '删除清单文件
- If Str <> "" Then '判断清单文本是否有效
- Arr = Split(Str, vbNewLine) '依分行标记拆分放入数组
- ReDim Result(LBound(Arr) To UBound(Arr) + 1, 1 To 3) '根据得到的文件路径数组定义结果数组
- Result(LBound(Result), 1) = "路径" '写入清单标题
- Result(LBound(Result), 2) = "文件名"
- Result(LBound(Result), 3) = "Url"
- For N = LBound(Arr) To UBound(Arr) '循环清单各项
- If Trim(Arr(N)) <> "" Then '如果路径有效,则
- Arrt = Split(Arr(N), "\") '拆分路径各级到数组
- Result(N + 1, 2) = Arrt(UBound(Arrt)) '写入文件名
- ReDim Preserve Arrt(LBound(Arrt) To UBound(Arrt) - 1) '将文件名项从数组中删除
- Result(N + 1, 1) = Join(Arrt, "\") '重新组合路径然后赋值给结果数组中的路径项
- Result(N + 1, 3) = .CreateShortcut(Arr(N)).targetpath '提取指定文件对应的网址链接地址赋值给数组中的网址项
- End If
- Next N
- [a1].Resize(UBound(Result) + 1, 3) = Result '向工作表中写出结果
- Columns.AutoFit '列宽自适应
- End If
- End With
- End Sub
详见附件及素材源帖.
 test.rar
|
2楼
rongjun |
学习k版代码
 |
3楼
亡者天下 |
这个很有用啊
 |
4楼
老糊涂 |
学习 |
免责声明
有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素，
经与ExcelTip.Net站长Apolloh商议并征得其同意，
现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示，
供有需要的人士查询使用，也慰缅曾经的论坛时代。
所示各个帖子的原作者如对版权有异议，
可与本人沟通提出，或于本站点留言，我们会尽快处理。
在此，感谢ExcelTip.Net站长Apolloh的支持，感谢本站点所有人**绿色风（QQ:79664738)**的支持与奉献，特此鸣谢！
------本人网名**KevinChengCW（QQ:1210618015)**原ExcelTip.Net总版主之一