vba 读写文件，utf-8编码格式
vba 读写文件，utf-8编码格式
2010-07-28 22:33 780人阅读 评论(0) 收藏 举报
这是一个转换UTF-8格式文本文件的示例，包括读取和写入，需要用到两个API函数：MultiByteToWideChar和WideCharToMultiByte
。
Public Declare Function MultiByteToWideChar Lib "kernel32" ( _
ByVal CodePage As Long, _
ByVal dwFlags As Long, _
ByRef lpMultiByteStr As Any, _
ByVal cchMultiByte As Long, _
ByVal lpWideCharStr As Long, _
ByVal cchWideChar As Long) As Long
Public Declare Function WideCharToMultiByte Lib "kernel32" ( _
ByVal CodePage As Long, _
ByVal dwFlags As Long, _
ByVal lpWideCharStr As Long, _
ByVal cchWideChar As Long, _
ByRef lpMultiByteStr As Any, _
ByVal cchMultiByte As Long, _
ByVal lpDefaultChar As String, _
ByVal lpUsedDefaultChar As Long) As Long
Public Const CP_UTF8 = 65001
' 将输入文本写进UTF8格式的文本文件
' 输入
' strInput：文本字符串
' strFile：保存的UTF8格式文件路径
' bBOM：True表示文件带"EFBBBF"头，False表示不带
Sub WriteUTF8File(strInput As String, strFile As String, Optional bBOM As Boolean = True)
Dim bByte As Byte
Dim ReturnByte() As Byte
Dim lngBufferSize As Long
Dim lngResult As Long
Dim TLen As Long
' 判断输入字符串是否为空
If Len(strInput) = 0 Then Exit Sub
On Error GoTo errHandle
' 判断文件是否存在，如存在则删除
If Dir(strFile) <> "" Then Kill strFile
TLen = Len(strInput)
lngBufferSize = TLen * 3 + 1
ReDim ReturnByte(lngBufferSize - 1)
lngResult = WideCharToMultiByte(CP_UTF8, 0, StrPtr(strInput), TLen, _
ReturnByte(0), lngBufferSize, vbNullString, 0)
If lngResult Then
lngResult = lngResult - 1
ReDim Preserve ReturnByte(lngResult)
Open strFile For Binary As #1
If bBOM = True Then
bByte = 239
Put #1, , bByte
bByte = 187
Put #1, , bByte
bByte = 191
Put #1, , bByte
End If
Put #1, , ReturnByte
Close #1
End If
Exit Sub
errHandle:
MsgBox Err.Description, , "错误 - " & Err.Number
End Sub
' 读取UTF8文件并转换为VBA中可读的字符串
' 输入
' strFile：UTF8格式文件的路径
Function readUTF8File(strFile As String) As String
Dim bByte As Byte
Dim ReturnByte() As Byte
Dim lngBufferSize As Long
Dim strBuffer As String
Dim lngResult As Long
Dim bHeader(1 To 3) As Byte
Dim i As Long
On Error GoTo errHandle
If Dir(strFile) = "" Then Exit Function
' 以二进制打开文件
Open strFile For Binary As #1
ReDim ReturnByte(0 To LOF(1) - 1) As Byte
' 读取前三个字节
Get #1, , bHeader(1)
Get #1, , bHeader(2)
Get #1, , bHeader(3)
' 判断前三个字节是否为BOM头
If bHeader(1) = 239 And bHeader(2) = 187 And bHeader(3) = 191 Then
For i = 3 To LOF(1) - 1
Get #1, , ReturnByte(i - 3)
Next i
Else
ReturnByte(0) = bHeader(1)
ReturnByte(1) = bHeader(2)
ReturnByte(2) = bHeader(3)
For i = 3 To LOF(1) - 1
Get #1, , ReturnByte(i)
Next i
End If
' 关闭文件
Close #1
' 转换UTF-8数组为字符串
lngBufferSize = UBound(ReturnByte) + 1
strBuffer = String$(lngBufferSize, vbNullChar)
lngResult = MultiByteToWideChar(65001, 0, ReturnByte(0), _
lngBufferSize, StrPtr(strBuffer), lngBufferSize)
readUTF8File = Left(strBuffer, lngResult)
Exit Function
errHandle:
MsgBox Err.Description, , "错误 - " & Err.Number
readUTF8File = ""
End Function
' 读取UTF8文件测试
Sub readFileTest()
Dim strFile As String
Dim strContent As String
Dim strSaveFile As String
' 获取文件名和路径
strFile = Application.GetOpenFilename("文本文件,*.txt", , "打开文本文件")
If strFile = "False" Then Exit Sub
strContent = readUTF8File(strFile)
If MsgBox("是否需要保存转换好的ANSI文本？", vbYesNo, "保存") = vbYes Then
strSaveFile = Application.GetSaveAsFilename(Mid(strFile, InStrRev(strFile, "/") + 1), "文本文件,*.txt")
If strSaveFile = "False" Then Exit Sub
Open strSaveFile For Binary As #1
Put #1, , strContent
Close #1
End If
End Sub
' 写入UTF8文件测试
Sub writeFileTest()
Dim strFile As String
Dim strContent As String
strContent = "这是一个UTF8文档测试"
strFile = Application.GetSaveAsFilename("", "文本文件,*.txt")
If strFile = "False" Then Exit Sub
'WriteUTF8File strContent, strFile
WriteUTF8File strContent, strFile, False
End Sub