惯性聚合 高效追踪和阅读你感兴趣的博客、新闻、科技资讯
阅读原文 在惯性聚合中打开

推荐订阅源

P
Proofpoint News Feed
Blog — PlanetScale
Blog — PlanetScale
GbyAI
GbyAI
C
Check Point Blog
腾讯CDC
Stack Overflow Blog
Stack Overflow Blog
Cyber Security Advisories - MS-ISAC
Cyber Security Advisories - MS-ISAC
The GitHub Blog
The GitHub Blog
A
About on SuperTechFans
Recent Announcements
Recent Announcements
L
LangChain Blog
Microsoft Azure Blog
Microsoft Azure Blog
小众软件
小众软件
J
Java Code Geeks
博客园_首页
Jina AI
Jina AI
美团技术团队
H
Help Net Security
MyScale Blog
MyScale Blog
Engineering at Meta
Engineering at Meta
奇客Solidot–传递最新科技情报
奇客Solidot–传递最新科技情报
人人都是产品经理
人人都是产品经理
Y
Y Combinator Blog
S
SegmentFault 最新的问题

博客园 - 撬棍

【.Net】2、8、16进制转换 【.Net】执行CMD命令 【.Net】获取随机数函数 【.Net】注册程序开机启动 【.Net】把窗体“钉”到桌面上 【.Net】多语言查看MSDN 【.Net】 显示星期字符串 【.Net】 判断时间字符串正确性 【.Net】 实现窗口拖动 【.Net】 Winform 单例运行实例 [C++]函数返回值 [C++]数组参数 [C++]const的指针使用 [C++]指针类型出参 【C++】split [C语言学习]之打印万年历 - 撬棍 - 博客园 [VB6.0]让程序在任务列表和资源管理器“隐身” [InstallShield]FindAllFiles与SetFileInfo配合实现文件加多文件属性设置 [VB]修改注册表让程序开机自动运行 - 撬棍 - 博客园
[VBA]Excel输出utf-8编码格式文件 使用WideCharToMultiByte
撬棍 · 2011-04-24 · via 博客园 - 撬棍

遇到问题:

  在使用vba输出.xml文件时,如果有汉字或日文出现无法打开。原因VBA生成的文本文件,默认是Gb2312编码。

  如何让输出文件格式是utf-8编码???

解决办法:

'API 函数WideCharToMultiByte参数说明
'第一个参数:指定要转换成的字符集代码页,它可以是任何已经安装的或系统自带的字符集,你也可以使用如下所示代码页之一。
'    CP_ACP 当前系统ANSI代码页
'    CP_MACCP 当前系统Macintosh代码页
'    CP_OEMCP 当前系统OEM代码页,一种原始设备制造商硬件扫描码
'    CP_SYMBOL Symbol代码页.
'    CP_THREAD_ACP 当前线程ANSI代码页,用于Windows 2000及以后版本,我不明白是什么
'    CP_UTF7 UTF-7,设置此值时lpDefaultChar和lpUsedDefaultChar都必须为NULL
'    CP_UTF8 UTF-8,设置此值时lpDefaultChar和lpUsedDefaultChar都必须为NULL
'第二个参数:指定如何处理没有转换的字符,但不设此参数函数会运行的更快一些,我都是把它设为0。
'第三个参数: 待转换的宽字符串?
'第四个参数:待转换宽字符串的长度,-1表示转换到字符串结尾。
'第五个参数: 接收转换后输出新串的缓冲区?
'第六个参数: 输出缓冲区大小?
'第七个参数: 指向字符的指针?
'第八个参数:开关变量的指针,用以表明是否使用过默认字符,一般设为0。
Private 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

Private Const CP_UTF8 = 65001
Private Sub WriteOut(strPath As String, str As String)
        Dim lBufSize As Long
        Dim lRest As Long
        Dim bUTF8() As Byte
        Dim TLen As Long
   
    TLen = Len(str)
    lBufSize = TLen * 3 + 1
    ReDim bUTF8(lBufSize - 1)
    lRest = WideCharToMultiByte(CP_UTF8, 0, StrPtr(str), TLen, bUTF8(0), lBufSize, vbNullString, 0)
    If lRest Then
        lRest = lRest - 1
        ReDim Preserve bUTF8(lRest)
        Open strPath For Binary As #1
        Put #1, , bUTF8
        Close #1
    End If
End Sub

'如何使用==================================================

Private Sub CommandButton1_Click()

    Const PATH = "E:\testfile.xml"
    Dim fso
    Set fso = CreateObject("Scripting.FileSystemObject")

    '这里建立一个空文件 并不打开他 建完拉到
    fso.CreateTextFile (PATH)
    '把所有的内容都放到这个字符串里
    Dim str As String
    For i = 1 To 50
        Dim test As String
        test = Trim(Worksheets("Sheet1").Range("A" + Trim(i)).Text)
        If Not test = vbNullString Then
            str = str & test & vbCrLf
        End If
    Next
    '不用打开文件 让WriteOut直接去写
    Call WriteOut(PATH, str)
    MsgBox "O K"

End Sub