在编写vba解决方案时经常会遇到需要处理文本文档的情况。
读取文本文档的内容或者将内容写入文本文档是一个常用的需求。
FileSystemObject对象提供了一系列读写文本文档的对象、属性和方法。
其中TextStream对象是处理文本文档的首选,它提供了对文本文档进行读和写的一系列方法。
以下是一个通用的遍历任意指定文件夹下的所有文本文档,并对文本文档的内容进行读和写的vba代码:
'只读打开文本文档 Const ForReading = 1 '可写打开文本文档 Const ForWriting = 2 '追加打开文本文档,写在原文本文档的末尾 Const ForAppending = 8 '以系统默认的方式打开文本文档 Const TristateUseDefault = -2 '以Unicode方式打开文本文档 Const TristateTrue = -1 '以ASCII方式打开文本文档 Const TristateFalse = 0 Sub QQ1722187970() Excel.Application.ScreenUpdating = False Excel.Application.Calculation = xlCalculationManual Excel.Application.DisplayAlerts = False Dim sPath As String '弹出选择文件夹对话框 sPath = GetPath '如果选中了具体的文件夹 If Len(sPath) Then '开始遍历所有的文件 EnuAllFiles sPath, False '定义文件系统对象 Dim oFSO As Object Set oFSO = CreateObject("Scripting.FileSystemObject") '将内容写入到文本文档中 sResultTxt = Excel.ThisWorkbook.Path & "/Result.txt" With oFSO '如果存在指定的文件 If .FileExists(sResultTxt) Then '如果存在则先删除 Kill sResultTxt '然后再创建 Set oTextStream = .OpenTextFile(sResultTxt, ForWriting, True, TristateUseDefault) With oTextStream '写入一行字符串+换行符 .WriteLine ("asdf") '写入若干个空行 .WriteBlankLines (10) '写入若干个字符 .Write ("asdf") '保存关闭 .Close '打开显示操作过的文本文档 Shell ("notepad " & sResultTxt) End With Else '直接读取 Set oTextStream = .OpenTextFile(sResultTxt, ForWriting, True, TristateUseDefault) With oTextStream '写入一行字符串+换行符 .WriteLine ("asdf") '写入若干个空行 .WriteBlankLines (10) '写入若干个字符 .Write ("asdf") '保存关闭 .Close '打开显示操作过的文本文档 Shell ("notepad " & sResultTxt) End With '如果存在指定的文件 '操作代码 End If End With End If Excel.Application.ScreenUpdating = True Excel.Application.Calculation = xlCalculationAutomatic Excel.Application.DisplayAlerts = True End Sub Function GetPath() As String '声明一个FileDialog对象变量 Dim oFD As FileDialog ' '创建一个选择文件对话框 ' Set oFD = Application.FileDialog(msoFileDialogFilePicker) '创建一个选择文件夹对话框 Set oFD = Application.FileDialog(msoFileDialogFolderPicker) '声明一个变量用来存储选择的文件名 Dim vrtSelectedItem As Variant With oFD '允许选择多个文件 .AllowMultiSelect = True '使用Show方法显示对话框,如果单击了确定按钮则返回-1。 If .Show = -1 Then '遍历所有选择的文件 For Each vrtSelectedItem In .SelectedItems '获取所有选择的文件的完整路径,用于各种操作 GetPath = vrtSelectedItem Next '如果单击了取消按钮则返回0 Else End If End With '释放对象变量 Set oFD = Nothing End Function Sub EnuAllFiles(ByVal sPath As String, Optional bEnuSub As Boolean = False) Dim arrResult() '定义文件系统对象 Dim oFSO As Object Set oFSO = CreateObject("Scripting.FileSystemObject") '定义文件夹对象 Dim oFolder As Object Set oFolder = oFSO.GetFolder(sPath) '定义文件对象 Dim oFile As Object '如果指定的文件夹含有文件 If oFolder.Files.Count Then For Each oFile In oFolder.Files With oFile '输出文件所在的盘符 Dim sDrive As String sDrive = .Drive '输出文件的类型 Dim sType As String sType = .Type '输出含后缀名的文件名称 Dim sName As String sName = .Name '输出含文件名的完整路径 Dim sFilePath As String sFilePath = .Path '输出文件的上次修改时间 Dim dDLM dDLM = .DateLastModified '输出文件的上次访问时间 Dim dDLA dDLA = .DateLastAccessed '输出文件的创建时间 Dim dDC dDC = .DateCreated '输出文件的属性 Dim sATT sATT = .Attributes '如果文件是文本文档且不是隐藏文件 If sType Like "文本文档" And Not (sName Like "*~$*") Then With oFSO Set oTextStream = .OpenTextFile(sFilePath, ForReading, True, TristateUseDefault) With oTextStream '读取整个文本文档的内容 sResult = .ReadAll '读取指定字符数的内容 sResult = .Read(6) Do Until .AtEndOfStream ' 逐行读取文本文档的内容 , 但不包含换行符 sResult = .Readline Loop '保存关闭 .Close End With End With End If End With Next '如果指定的文件夹不含有文件 Else End If '如果要遍历子文件夹 If bEnuSub = True Then '定义子文件夹集合对象 Dim oSubFolders As Object Set oSubFolders = oFolder.SubFolders If oSubFolders.Count > 0 Then For Each oTempFolder In oSubFolders sTempPath = oTempFolder.Path Call EnuAllFiles(sTempPath, True) Next End If Set oSubFolders = Nothing End If Set oFile = Nothing Set oFolder = Nothing Set oFSO = Nothing End Sub
发表评论