字符串ANSI编码与utf8编码互转函数

ggmmlol

今天，找到了一段能够把字符串ANSI编码与utf8编码互转的函数代码，加工了一下，使之兼容64位和32位的VBA环境，现分享给寻找它的人。

1. #If Win64 And VBA7 Then
   
2.     Private Declare PtrSafe Function MultiByteToWideChar Lib "kernel32 " (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As LongPtr, ByVal cchMultiByte As Long, ByVal lpWideCharStr As LongPtr, ByVal cchWideChar As Long) As Long
   
3.     Private Declare PtrSafe Function WideCharToMultiByte Lib "kernel32 " (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As LongPtr, ByVal cchWideChar As Long, ByVal lpMultiByteStrPtr As LongPtr, ByVal cchMultiByte As Long, ByVal lpDefaultChar As LongPtr, ByVal lpUsedDefaultChar As LongPtr) As Long
   
4. #Else
   
5.     Private Declare  Function MultiByteToWideChar Lib "kernel32 " (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long
   
6.     Private Declare  Function WideCharToMultiByte Lib "kernel32 " (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, ByVal lpUsedDefaultChar As Long) As Long
   
7. #End If
   
8. Private Const CP_ACP = 0 ' default to ANSI code page
   
9. Private Const CP_UTF8 = 65001 ' default to UTF-8 code page
   
10. 
    
11. '字符转 UTF8
    
12. Public Function EncodeToBytes(ByVal sData As String) As Byte() ' Note: Len(sData) > 0
    
13.     Dim aRetn() As Byte
    
14.     Dim nSize As Long
    
15.     nSize = WideCharToMultiByte(CP_UTF8, 0, StrPtr(sData), -1, 0, 0, 0, 0) - 1
    
16.     If nSize = 0 Then Exit Function
    
17.     ReDim aRetn(0 To nSize - 1) As Byte
    
18.     WideCharToMultiByte CP_UTF8, 0, StrPtr(sData), -1, VarPtr(aRetn(0)), nSize, 0, 0
    
19.     EncodeToBytes = aRetn
    
20.     Erase aRetn
    
21. End Function
    
22. 
    
23. ' UTF8 转字符
    
24. Public Function DecodeToBytes(ByVal sData As String) As Byte() ' Note: Len(sData) > 0
    
25.     Dim aRetn() As Byte
    
26.     Dim nSize As Long
    
27.     nSize = MultiByteToWideChar(CP_UTF8, 0, StrPtr(sData), -1, 0, 0) - 1
    
28.     If nSize = 0 Then Exit Function
    
29.     ReDim aRetn(0 To 2 * nSize - 1) As Byte
    
30.     MultiByteToWideChar CP_UTF8, 0, StrPtr(sData), -1, VarPtr(aRetn(0)), nSize
    
31.     DecodeToBytes = aRetn
    
32.     Erase aRetn
    
33. End Function
    
34. 
    
35. Sub CommandButton1_Click()
    
36.     Dim s As String
    
37.     s = StrConv(EncodeToBytes("中文"), vbUnicode) '将utf编码的数组转VB可处理字符
    
38.     MsgBox s
    
39.     t = DecodeToBytes(StrConv(s, vbFromUnicode))
    
40.     MsgBox t
    
41. End Sub

复制代码

ANSI与Utf8编码互转.rar (19.39 KB, 下载次数: 285)

2019-12-31 16:11 上传

点击文件名下载附件

补充内容 (2022-12-12 06:10):
更新到9楼

darklesson

谢谢分享，经常操作文本文件的人就会知道是好东西

ggmmlol

有了这几个函数，可以解决Excel内置的二维码不支持汉字的问题。

方案如下：
首先，把需要转二维码的含有汉字的字符串，转成 utf8编码的字节数组（这一步，用第一个自定义函数），再把数组转成单字节字符串数组（这一步，使用chr函数），然后把字符串数组连接成一个字符串（使用Join函数），这时，就可以把这个字符串传递给内置的条码控件来生成二维码了。

解码过程：
先用二维码扫码软件，得到全部由单字节字符构成的字符串，再对这个单字节字符串进行解码：把每个单字节字符的编码写入一个字节数组的元素中，然后把字节数组转成ANSI编码(VB内码）的字符串（这一步只需要VBA本身的StrConv函数解决）。

powerremain

好东西！！！多谢分享

ggmmlol

Base64转换.rar (29.45 KB, 下载次数: 117)

2020-3-31 17:31 上传

点击文件名下载附件

silentdustbin

楼主，如果我输入的是三个字比如中国人，最后解析出来是中国??，最后一个字符有异常

a19410593

如果是已经是txt文档的文件，如何批量将txt文档做转换？

风1969

楼主老师您好，请教个二维码编码问题：
用字符“#5p2O”生成二维码，扫描出“李”字。这是什么编码呀？
谢谢指导！

ggmmlol

Base64转换.rar (31.13 KB, 下载次数: 38)

2022-12-12 06:08 上传

点击文件名下载附件

游乐缘

感谢分享，留名学习