使用UTF-8编码将表单保存到TXT

时间:2016-08-26 04:24:55

标签: vba excel-vba 64-bit activex excel

我正在编写用于生成需要80字节行格式的报告的脚本 目前,我的脚本正确格式化所有字段,将它们连接到一个列,并删除其余字段。此连接列具有分隔字段的空格,这些字段在保存时无法删除。所有这些都是在Windows 10上的64位版本的Excel 2016上完成的。
如何将文件保存为UTF-8编码的文本文件?

2 个答案:

答案 0 :(得分:0)

我最终编写了一个打开Notepad ++的AHK脚本,更改编码,保存文件并关闭它。不像我希望的那样优雅,但它完成了工作。

答案 1 :(得分:0)

此处针对Office 64位修改的示例电子表格中的代码

<强> UTFTest.bas

' Converting a VBA string to an array of bytes in UTF-8 encoding

' $Date: 2015-06-30 10:05Z $
' $Original Author: David Ireland $

' Copyright (C) 2015 DI Management Services Pty Limited
' <http://www.di-mgt.com.au> <http://www.cryptosys.net>

Option Explicit
Option Base 0

''' Extract a set of VBA "Unicode" strings from Excel sheet, encode in UTF-8 and display details
Public Sub ShowStuff()
    Dim strData As String

    ' Plain ASCII
    ' "abc123"
    ' U+0061, U+0062, U+0063, U+0031, U+0032, U+0033
    ' EXCEL: Get value from cell A1
    strData = Worksheets("Sheet1").Cells(1, 1)
    Debug.Print vbCrLf & Worksheets("Sheet1").Cells(1, 2)
    ProcessString (strData)

    ' Spanish
    ' LATIN SMALL LETTER[s] [AEIO] WITH ACUTE and SMALL LETTER N WITH TILDE
    ' U+00E1, U+00E9, U+00ED, U+00F3, U+00F1
    ' EXCEL: Get value from cell A3
    strData = Worksheets("Sheet1").Cells(3, 1)
    Debug.Print vbCrLf & Worksheets("Sheet1").Cells(3, 2)
    ProcessString (strData)

    ' Japanese
    ' "Hello" in Hiragana characters is KO-N-NI-TI-HA (Kon'nichiwa)
    ' U+3053 (hiragana letter ko), U+3093 (hiragana letter n),
    ' U+306B (hiragana letter ni), U+3061 (hiragana letter ti),
    ' and U+306F (hiragana letter ha)
    ' EXCEL: Get value from cell A5
    strData = Worksheets("Sheet1").Cells(5, 1)
    Debug.Print vbCrLf & Worksheets("Sheet1").Cells(5, 2)
    ProcessString (strData)

    ' Chinese
    ' CN=ben (U+672C), C= zhong guo (U+4E2D, U+570B), OU=zong ju (U+7E3D, U+5C40)
    ' EXCEL: Get value from cell A7
    strData = Worksheets("Sheet1").Cells(7, 1)
    Debug.Print vbCrLf & Worksheets("Sheet1").Cells(7, 2)
    ProcessString (strData)

    ' Hebrew
    ' "abc" U+0061, U+0062, U+0063
    ' SPACE U+0020
    ' [NB right-to-left order]
    ' U+05DB HEBREW LETTER KAF
    ' U+05E9 HEBREW LETTER SHIN
    ' U+05E8 HEBREW LETTER RESH
    ' SPACE "f123" U+0066 U+0031 U+0032 U+0033
    ' EXCEL: Get value from cell A9
    strData = Worksheets("Sheet1").Cells(9, 1)
    Debug.Print vbCrLf & Worksheets("Sheet1").Cells(9, 2)
    ProcessString (strData)

End Sub

Public Function ProcessString(strData As String)
    Dim abData() As Byte
    Dim strOutput As String

    Debug.Print strData ' This should show "?" for non-ANSI characters

    strOutput = Utf8BytesFromString(strData)

    abData = strOutput
    ' Reset array width to Actual Number of Bytes
    ReDim Preserve abData(Len(strOutput) - 1)

    Debug.Print bv_HexFromBytesSp(abData)

    Debug.Print "Strlen=" & Len(strData) & " chars; utf8len=" & Len(strOutput) & " bytes"

End Function

''' Returns hex-encoded string from array of bytes (with spaces)
''' E.g. aBytes(&HFE, &HDC, &H80) will return "FE DC 80"
Public Function bv_HexFromBytesSp(aBytes() As Byte) As String
    Dim i As Long

    If Not IsArray(aBytes) Then
        Exit Function
    End If

    For i = LBound(aBytes) To UBound(aBytes)
        If (i > 0) Then bv_HexFromBytesSp = bv_HexFromBytesSp & " "
        If aBytes(i) < 16 Then
            bv_HexFromBytesSp = bv_HexFromBytesSp & "0" & Hex(aBytes(i))
        Else
            bv_HexFromBytesSp = bv_HexFromBytesSp & Hex(aBytes(i))
        End If
    Next

End Function

和Win64转换的API调用

' basUtf8FromString

' Written by David Ireland DI Management Services Pty Limited 2015
' <http://www.di-mgt.com.au> <http://www.cryptosys.net>

Option Explicit

' CodePage constant for UTF-8
Private Const CP_UTF8 = 65001

#If Win64 Then

    Private Declare PtrSafe Function GetACP Lib "Kernel32" () As LongPtr

    Private Declare PtrSafe Function MultiByteToWideChar Lib "Kernel32" (ByVal CodePage As LongPtr, _
        ByVal dwflags As LongPtr, ByVal lpMultiByteStr As LongPtr, ByVal cchMultiByte As LongPtr, _
        ByVal lpWideCharStr As LongPtr, ByVal cchWideChar As LongPtr) As LongPtr

    Private Declare PtrSafe Function WideCharToMultiByte Lib "Kernel32" (ByVal CodePage As LongPtr, _
        ByVal dwflags As LongPtr, ByVal lpWideCharStr As LongPtr, ByVal cchWideChar As LongPtr, _
        ByVal lpMultiByteStr As LongPtr, ByVal cchMultiByte As LongPtr, ByVal lpDefaultChar As LongPtr, _
        lpUsedDefaultChar As LongPtr) As LongPtr

#Else

    Private Declare PtrSafe Function GetACP Lib "Kernel32" () As Long

    Private Declare PtrSafe Function MultiByteToWideChar Lib "Kernel32" (ByVal CodePage As Long, _
        ByVal dwflags As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, _
        ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long

    Private Declare PtrSafe Function WideCharToMultiByte Lib "Kernel32" (ByVal CodePage As Long, _
        ByVal dwflags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, _
        ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, _
        lpUsedDefaultChar As Long) As Long

#End If

''' Return byte array with VBA "Unicode" string encoded in UTF-8
Public Function Utf8BytesFromString(strInput As String) As String
    Dim nBytes      As LongPtr
    Dim pwz         As LongPtr
    Dim pwzBuffer   As LongPtr

    Dim sBuffer     As String

    ' Get length in bytes *including* terminating null
    pwz = StrPtr(strInput)
    nBytes = WideCharToMultiByte(CP_UTF8, 0&, pwz, -1, 0&, 0&, ByVal 0&, ByVal 0&)

    sBuffer = String$(nBytes + 1, vbNullChar)
    pwzBuffer = StrPtr(sBuffer)

    nBytes = WideCharToMultiByte(CP_UTF8, 0&, pwz, -1, pwzBuffer, Len(sBuffer), ByVal 0&, ByVal 0&)
    Utf8BytesFromString = Left$(sBuffer, nBytes - 1)
End Function

摘自http://www.di-mgt.com.au/howto-convert-vba-unicode-to-utf8.html