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

推荐订阅源

酷 壳 – CoolShell
酷 壳 – CoolShell
H
Hacker News: Front Page
P
Palo Alto Networks Blog
T
ThreatConnect
Apple Machine Learning Research
Apple Machine Learning Research
博客园_首页
T
True Tiger Recordings
P
Privacy & Cybersecurity Law Blog
B
Blog
IT之家
IT之家
Last Week in AI
Last Week in AI
F
Full Disclosure
Hacker News: Ask HN
Hacker News: Ask HN
C
Comments on: Blog
Microsoft Azure Blog
Microsoft Azure Blog
C
Cybersecurity and Infrastructure Security Agency CISA
Microsoft Security Blog
Microsoft Security Blog
博客园 - 【当耐特】
N
News and Events Feed by Topic
NISL@THU
NISL@THU
腾讯CDC
雷峰网
雷峰网
Security Latest
Security Latest
李成银的技术随笔
M
Microsoft Research Blog - Microsoft Research
L
LangChain Blog
L
Lohrmann on Cybersecurity
cs.CL updates on arXiv.org
cs.CL updates on arXiv.org
C
Check Point Blog
Y
Y Combinator Blog
Recent Announcements
Recent Announcements
博客园 - Franky
N
News | PayPal Newsroom
V
V2EX
A
About on SuperTechFans
The Register - Security
The Register - Security
月光博客
月光博客
奇客Solidot–传递最新科技情报
奇客Solidot–传递最新科技情报
Google Online Security Blog
Google Online Security Blog
MyScale Blog
MyScale Blog
Cisco Talos Blog
Cisco Talos Blog
Vercel News
Vercel News
WordPress大学
WordPress大学
C
Cyber Attacks, Cyber Crime and Cyber Security
The Hacker News
The Hacker News
IntelliJ IDEA : IntelliJ IDEA – the Leading IDE for Professional Development in Java and Kotlin | The JetBrains Blog
IntelliJ IDEA : IntelliJ IDEA – the Leading IDE for Professional Development in Java and Kotlin | The JetBrains Blog
爱范儿
爱范儿
A
Arctic Wolf
L
LINUX DO - 最新话题
freeCodeCamp Programming Tutorials: Python, JavaScript, Git & More

博客园 - 撬棍

【.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