VBA文件处理(UTF-8)

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