如何用vba对文本文档进行读写操作?

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

发表评论