梧州网站设计公司百度网址大全网址导航

图(1)

        前几天我跟大家分享了在VBA中如何获取指定类型文件的路径的方法，其中最重要的一个思路就是在处理完当前目录的文件后，再调用程序自身来对子目录进行处理，以此来实现对子目录的无限循环，直至所有文件都处理完毕为止。按照此设计思路，今天我来跟大家分享VBA如何合并指定路径的txt文件。

        为方便程序调用，我们将合并过程命名为MergeTxtFile，它携带两个参数，一个是filePath表示指定路径，另一个是fileName表示合并后的文件名，因为处理过程是循环进行的，且涉及合并文件和公共变量的清理问题，循环过程只能单独设计为子过程MergeTxt，代码如下：

Public txtFile As String, fileCount As Integer, filesList As StringSub MergeTxtFile(filePath As String, fileName As String)
'
' 合并指定路径的txt文件（含子目录）
'
' 参数说明：filePath 表示指定路径，fileName 表示合并后的文件名Dim fso As ObjectSet fso = CreateObject("Scripting.FileSystemObject")If Not fso.folderExists(filePath) ThenMsgBox "找不到路径：" & vbCrLf & filePath, vbOKOnly + vbExclamation, "错误"Exit SubEnd IftxtFile = filePath & "\" & fileNameIf fso.fileExists(txtFile) ThenKill txtFileIf Err.Number <> 0 Then   ' 错误检查Err.Clear   ' 清除错误MsgBox "以下文件已打开，请先关闭。" & vbCrLf & txtFile, vbOKOnly + vbExclamation, "错误"Exit SubEnd IfEnd If' 合并文件Call MergeTxt(filePath, fileName)Debug.Print filesList & vbCrLf & "执行完毕！总共合并" & fileCount & "个" & "txt文件"'清理公共变量txtFile = ""fileCount = 0filesList = ""
End SubSub MergeTxt(filePath As String, fileName As String)
'
' 合并指定路径的txt文件（含子目录）
'Dim file As ObjectDim fileContent As StringDim fileNum As Integer'Dim fileCount As IntegerDim txtFolder As ObjectDim txtNum As IntegertxtNum = FreeFile                     ' 获取新文件号Open txtFile For Append As #txtNum    ' 打开合并文件（追加模式）'遍历主目录的每个文件Dim fso As ObjectSet fso = CreateObject("Scripting.FileSystemObject")Set txtFolder = fso.GetFolder(filePath)For Each file In txtFolder.FilesIf LCase(fso.GetExtensionName(file.path)) = "txt" Then' 获取文件列表If file.Name <> fileName ThenIf Len(filesList) = 0 ThenfilesList = file.pathElsefilesList = filesList & vbCrLf & file.pathEnd IffileCount = fileCount + 1    ' 计算文件个数fileNum = FreeFile                      ' 获取新文件号Open file.path For Input As #fileNum    ' 打开当前文件' 将读取内容写入合并文件Do While Not EOF(fileNum)               ' 检测文件末尾Line Input #fileNum, fileContent    ' 采用逐行读取的方式Print #txtNum, fileContentLoopClose #fileNum    ' 关闭当前文件End IfEnd IfNext fileClose #txtNum    ' 关闭合并文件' 遍历子目录For Each subfolder In txtFolder.subFoldersCall MergeTxt(subfolder.path, fileName)    ' 调用程序自身处理子目录Next subfolderEnd Sub

        以上是通用过程，在使用过程中，我们只需要重新定义变量filePath和fileName的值即可，下面是使用的演示代码：

Sub Demo_MergeTxtFile()
'
' 演示MergeTxtFile函数用法
'Dim filePath As StringDim fileName As StringfilePath = "D:\Users\Hero\Desktop\办公室"fileName = "合并TXT.txt"Call MergeTxtFile(filePath, fileName)End Sub

        执行结果如下图：

图(2)