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

推荐订阅源

Simon Willison's Weblog
Simon Willison's Weblog
T
Threatpost
Threat Intelligence Blog | Flashpoint
Threat Intelligence Blog | Flashpoint
Spread Privacy
Spread Privacy
cs.AI updates on arXiv.org
cs.AI updates on arXiv.org
cs.CV updates on arXiv.org
cs.CV updates on arXiv.org
Engineering at Meta
Engineering at Meta
T
Tenable Blog
C
Cisco Blogs
T
The Blog of Author Tim Ferriss
NISL@THU
NISL@THU
T
Threat Research - Cisco Blogs
T
The Exploit Database - CXSecurity.com
P
Privacy & Cybersecurity Law Blog
Recent Commits to openclaw:main
Recent Commits to openclaw:main
S
Secure Thoughts
N
News and Events Feed by Topic
Google DeepMind News
Google DeepMind News
博客园 - 三生石上(FineUI控件)
Microsoft Azure Blog
Microsoft Azure Blog
月光博客
月光博客
H
Hacker News: Front Page
I
InfoQ
L
LangChain Blog
Security Latest
Security Latest
The Cloudflare Blog
Forbes - Security
Forbes - Security
D
Darknet – Hacking Tools, Hacker News & Cyber Security
Stack Overflow Blog
Stack Overflow Blog
TaoSecurity Blog
TaoSecurity Blog
量子位
Cyber Security Advisories - MS-ISAC
Cyber Security Advisories - MS-ISAC
V
Visual Studio Blog
Scott Helme
Scott Helme
爱范儿
爱范儿
A
Arctic Wolf
F
Full Disclosure
酷 壳 – CoolShell
酷 壳 – CoolShell
Schneier on Security
Schneier on Security
N
News and Events Feed by Topic
C
CXSECURITY Database RSS Feed - CXSecurity.com
L
LINUX DO - 最新话题
V2EX - 技术
V2EX - 技术
OSCHINA 社区最新新闻
OSCHINA 社区最新新闻
人人都是产品经理
人人都是产品经理
The Hacker News
The Hacker News
Hugging Face - Blog
Hugging Face - Blog
Security Archives - TechRepublic
Security Archives - TechRepublic
Know Your Adversary
Know Your Adversary
Application and Cybersecurity Blog
Application and Cybersecurity Blog

博客园 - 撬棍

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