一个简单的需求： Windows 环境下用 VBS/VBA 来实现抽取某一个特定目录下的全部所有文件，要求遍历当前目录下所有的子目录。 注意各子目录下文件的文件名可能会重复，各子目录下存在空目录的情况。
实现 VBS 代码
' 需要遍历的目录路径
dim strDirPath = "c:\dir"
' 遍历目录
Private Sub FileTree(strPath)
Set obFso = CreateObject("Scripting.FileSystemObject")
If obFso.FolderExists(strPath) Then
Set obFolder = obFso.GetFolder(strPath)
' 遍历当前目录下的所有目录，递归调用
Set obSubFolders = obFolder.SubFolders
For Each obSubFolder In obSubFolders
Call FileTree(obSubFolder.Path & "")
Next
' 剔除当前目录
If strPath = Trim(strDirPath) Then
Exit Sub
End If
' 遍历当前目录下的所有文件
Set obFiles = obFolder.Files
For Each obFile In obFiles
Call ExcuteFolderConcentrate(obFile.Path & "")
Next
Else
MsgBox "Invalide Path"
Exit Sub
End If
End Sub
' 文件归集操作
Private Sub ExcuteFolderConcentrate(strPath)
Set obFso = CreateObject("Scripting.FileSystemObject")
If obFso.FileExists(strPath) Then
fullPath = Trim(strDirPath) & “\"
' 按目录层级设置新文件名
newFileName = Replace(Right(strPath, Len(strPath) - Len(fullPath)), "\", "_”)
' 重复文件重新命名
If obFso.FileExists(fullPath & newFileName) Then
Call obFso.copyFile(strPath, fullPath & newFileName & ".duplicate")
Else
Call obFso.copyFile(strPath, fullPath & newFileName)
End If
End If
End Sub
' 遍历整个目录，完成文件归集
FileTree (strDirPath)
' 重新打开目录文件夹
CreateObject("Shell.Application").Explore strDirPath