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

推荐订阅源

博客园 - 三生石上(FineUI控件)
Martin Fowler
Martin Fowler
月光博客
月光博客
AI
AI
B
Blog
钛媒体:引领未来商业与生活新知
钛媒体:引领未来商业与生活新知
C
CXSECURITY Database RSS Feed - CXSecurity.com
WordPress大学
WordPress大学
GbyAI
GbyAI
L
Lohrmann on Cybersecurity
O
OpenAI News
Schneier on Security
Schneier on Security
P
Palo Alto Networks Blog
Cyber Security Advisories - MS-ISAC
Cyber Security Advisories - MS-ISAC
T
Troy Hunt's Blog
V2EX - 技术
V2EX - 技术
W
WeLiveSecurity
L
LINUX DO - 最新话题
人人都是产品经理
人人都是产品经理
S
Security Affairs
OSCHINA 社区最新新闻
OSCHINA 社区最新新闻
A
Arctic Wolf
Recorded Future
Recorded Future
Microsoft Security Blog
Microsoft Security Blog
Threat Intelligence Blog | Flashpoint
Threat Intelligence Blog | Flashpoint
G
GRAHAM CLULEY
N
Netflix TechBlog - Medium
TaoSecurity Blog
TaoSecurity Blog
C
Check Point Blog
Scott Helme
Scott Helme
cs.CV updates on arXiv.org
cs.CV updates on arXiv.org
Apple Machine Learning Research
Apple Machine Learning Research
PCI Perspectives
PCI Perspectives
www.infosecurity-magazine.com
www.infosecurity-magazine.com
Vercel News
Vercel News
The Hacker News
The Hacker News
Y
Y Combinator Blog
Latest news
Latest news
SecWiki News
SecWiki News
Hugging Face - Blog
Hugging Face - Blog
cs.AI updates on arXiv.org
cs.AI updates on arXiv.org
Google Online Security Blog
Google Online Security Blog
Webroot Blog
Webroot Blog
Google DeepMind News
Google DeepMind News
Recent Commits to openclaw:main
Recent Commits to openclaw:main
C
Cisco Blogs
博客园_首页
H
Hackread – Cybersecurity News, Data Breaches, AI and More
宝玉的分享
宝玉的分享
L
LINUX DO - 热门话题

博客园 - 撬棍

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