在编写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


发表评论