欢迎您访问程序员文章站本站旨在为大家提供分享程序员计算机编程知识!
您现在的位置是: 首页

VBA文件处理(UTF-8)

程序员文章站 2022-07-08 16:21:19
...
Option Explicit
'--------------------------------------------------------
'[Class name]:  clsTxtFile
'[Description]:      Read Or Write Txt File
'--------------------------------------------------------

Private mFileNumber As Integer
Private mIsOpen As Boolean
Private mEncoding As String
Private mStream As Object
Private mFilePath As String

'--------------------------------------------------------
'[Function name]:  OpenFile
'[Description]:    Open file
'[Parameter]:    (1) file path (2)encoding (eg:utf-8)
'--------------------------------------------------------
Public Sub OpenFile(path As String, encoding As String)
    
    mEncoding = encoding
    mFilePath = path
    If mEncoding <> "" Then
        Set mStream = CreateObject("Adodb.Stream")
        With mStream
            .Type = 2 '1:binary 2:text
            .Mode = 3 '1:Read 2:Write 3:ReadWrite
            .Open
            .LoadFromFile path
            .Charset = "UTF-8"
            .Position = 2 'encoding's position
        End With
    Else
        mFileNumber = FreeFile
        Open path For Input As #mFileNumber
    End If
    mIsOpen = True
End Sub

'--------------------------------------------------------
'[Function name]:  CreateFile
'[Description]:    Create file
'[Parameter]:    (1) file path (2)encoding
'--------------------------------------------------------
Public Sub CreateFile(path As String, encoding As String)
    
    mEncoding = encoding
    mFilePath = path
    
    CreateFileCore (path)
    
    If mEncoding <> "" Then
        Set mStream = CreateObject("Adodb.Stream")
        With mStream
            .Type = 2 '1:binary 2:text
            .Mode = 3 '1:Read 2:Write 3:ReadWrite
            .Open
            .Charset = "UTF-8"
        End With
    Else
        mFileNumber = FreeFile
        Open path For Binary Access Write As #mFileNumber
    End If
    mIsOpen = True
End Sub

'--------------------------------------------------------
'[Function name]:  CreateFileCore
'[Description]:    cretae file 
'[Parameter]:    (1) file path
'--------------------------------------------------------
Private Sub CreateFileCore(path As String)

    Dim fso As Object
    Dim folderName As String
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    If fso.FileExists(path) Then
        'file exists,delete
        fso.DeleteFile path, True
    Else
       'file not exists,create 
        folderName = fso.GetParentFolderName(path)
        If Not fso.FolderExists(folderName) Then
            fso.CreateFolder (folderName)
        End If
    End If
    
    fso.CreateTextFile path, True
End Sub

'--------------------------------------------------------
'[Function name]:  ReadLine
'[Description]:   read  a line
'[Return Value]:  line string
'--------------------------------------------------------
Public Function ReadLine() As String
    
    Dim strLine As String
    If mEncoding <> "" Then
        strLine = mStream.ReadText(-2) '-1:adReadAll -2:adReadLine
    Else
        Line Input #mFileNumber, strLine
    End If
    
    ReadLine = strLine
End Function

'--------------------------------------------------------
'[Function name]:  WriteLine
'[Description]:    Write line
'[Parameter]:    (1) line
'--------------------------------------------------------
Public Sub WriteLine(strLine As String)

    If mEncoding <> "" Then
        Call mStream.WriteText(strLine, 1)  '0:adWriteChar 1:adWriteLine
    Else
        strLine = strLine & vbCrLf
        Put #mFileNumber, , strLine
    End If
End Sub

'--------------------------------------------------------
'[Function name]:  IsEndOfFile
'[Description]:    if is the end of the file
'[Return Value]:  true:end of the file false:not end of the file
'--------------------------------------------------------
Public Function IsEndOfFile() As Boolean

    If mEncoding <> "" Then
        IsEndOfFile = mStream.EOS
    Else
        IsEndOfFile = EOF(mFileNumber)
    End If
End Function

'--------------------------------------------------------
'[Function name]:  CloseFile
'[Description]:    close file
'--------------------------------------------------------
Public Sub CloseFile()
        
    If mIsOpen Then
        If mEncoding <> "" Then
            mStream.SaveToFile mFilePath, 2 'adSaveCreateNotExist =1 adSaveCreateOverWrite = 2
            mStream.Close
            Set mStream = Nothing
        Else
            Close mFileNumber
        End If
    End If
End Sub