zoukankan      html  css  js  c++  java
  • [VBA]Excel输出utf8编码格式文件 使用WideCharToMultiByte

    遇到问题:

      在使用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

  • 相关阅读:
    linux ---用uniq实现文件的并集和交集
    vim的.vimrc文件设置
    CURL常用命令
    快速入门系列--MVC--03控制器和IOC应用
    linux下git安装
    openerp child_of操作符深度解析
    apache2 + virtualenv +djangocms
    django-cms安装
    pycharm3.4 下svn 项目checkout&配置
    在django项目外,使用django.db链接数据库(postgres)
  • 原文地址:https://www.cnblogs.com/fjfjfjfjfjfj/p/2026190.html
Copyright © 2011-2022 走看看