一個簡單的需求： 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 "無效路徑"
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