|
稍微做了点改动,第二个问题通过判断文件的后缀名来实现,第一个问题虽然实现了,但我不是很建议这种做法,具体看代码注解。- Sub 提取指定文件夹内的所有文件名() '含所有子文件夹内的文件
- Dim Fso As Object, arrf$(), mf&
- Set Fso = CreateObject("Scripting.FileSystemObject")
- Call GetFiles(CreateObject("Shell.Application").BrowseForFolder(0, "请选择文件夹", 0, "").Self.Path, Fso, arrf, mf)
- [B1].Resize(mf, 2) = Application.Transpose(arrf) '这里必须从第一行开始,即可用是A1,C1,单B2,A2都不行
- Set Fso = Nothing
- End Sub
- Sub 提取指定文件夹内的所有文件名公式() '含所有子文件夹内的文件
- Dim Fso As Object, arrf$(), mf&, Find$()
- Set Fso = CreateObject("Scripting.FileSystemObject")
- Call GetFiles(CreateObject("Shell.Application").BrowseForFolder(0, "请选择文件夹", 0, "").Self.Path, Fso, arrf, mf)
- [B1].Resize(mf) = Application.Transpose(Mid(arrf, (Find("(", arrf) + 1), Find(")", arrf) - (Find("(", arrf) + 1)))
- Set Fso = Nothing
- End Sub
- Private Sub GetFiles(ByVal sPath$, ByRef Fso As Object, ByRef arrf$(), ByRef mf&)
- Dim Folder As Object
- Dim SubFolder As Object
- Dim File As Object
- Dim En$
- Set Folder = Fso.GetFolder(sPath)
- For Each File In Folder.Files
- En = Fso.GetExtensionName(sPath & "" & File.Name)
- If En Like "*xls*" Then
- mf = mf + 1
- ReDim Preserve arrf(1 To 2, 1 To mf)
- arrf(1, mf) = File.Name
- arrf(2, mf) = "=Mid(B" & mf & ", (Find(""("", B" & mf & ") + 1), Find("")"", B" & mf & ") - (Find(""("", B" & mf & ") + 1))"
- End If
- Next
- For Each SubFolder In Folder.SubFolders
- Call GetFiles(SubFolder.Path, Fso, arrf, mf)
- Next
- Set Folder = Nothing
- Set File = Nothing
- End Sub
复制代码 |
|