2

这是在 Word for MAC VBA 中。我想将 Unicode 字符从文本框中保存到文本文件。例如这个字符“⅛”。

我使用此代码。

Dim N as Long
N = FreeFile
Dim strText as String
strText = Textbox1.Text 'This is what is in the textbox "⅛"
Open <file path> For Output As N 
     Print #N, strText
Close N

它不保存 Unicode 字符。我知道我必须更改文本编码格式。我怎么做？

同样，如何读取 Unicode 格式的文本文件？

4

4 回答 4

11

我希望这也适合 Mac 上的 Word 的 VBA，但在 Windows 上，我有 FileSystemObject 的 CreateTextFile 方法（请参阅MSDN doc）。在那里我可以定义创建一个 unicode 文本文件。

  Set fsObject = CreateObject("Scripting.FileSystemObject")
  Set xmlFile = fsObject.CreateTextFile("path/filename.txt", True, True) 'the second "true" forces a unicode file.

  xmlFile.write "YourUnicodeTextHere"
  xmlFile.close
于 2013-11-13T21:03:21.587 回答
7

VBA 不能以这种方式以 UTF-8 编码文本。使用 ADODB - 是的，用于文本，而不是用于数据库。

'ensure reference is set to Microsoft ActiveX DataObjects library
'(the latest version of it) under "tools/references"
Sub AdoTest()
    Dim adoStream As ADODB.Stream
    
    Set adoStream = New ADODB.Stream
    
    'Unicode coding
    adoStream.Charset = "Unicode" 'or any string listed in registry HKEY_CLASSES_ROOT\MIME\Database\Charset
    
    'open sream
    adoStream.Open
    
    'write a text
    adoStream.WriteText "Text for testing: ěšč", StreamWriteEnum.stWriteLine
    
    'save to file
    adoStream.SaveToFile "D:\a\ado.txt"
    
    adoStream.Close
End Sub

阅读更简单，请在此处查看我的答案：

Unicode 和 UTF-8 与 VBA

编辑：我已经插入了完整的例子。

编辑 2：添加了对注册表中编码列表的引用

于 2013-09-24T13:21:31.853 回答
2

问题是针对 Mac 上的 VBA，恐怕没有一个答案适用于 Mac。

问题是关于Unicode的，它有多种形式。我将解决它的 UTF-16 方面。UTF-8 走的是不同的道路，但也不难。AFAIU，您的问题是关于 UTF-16 字符串的。

下面的代码没有错误处理，我会让你处理的。

Function writeUnicodeTextToFile(filePathName As String, myText As String)

`Dim myFileNumber As Long, I As Long, byteArray() As Byte

myFileNumber = FreeFile()
Open filePathName For Binary As #myFileNumber

ReDim byteArray(1)

' Create a BOM for your Unicode flavour
' (CHOOSE! one of the two, programmatically, or hard-code it)
 ' => Little Endian
    byteArray(0) = 255: byteArray(1) = 254
' => Big Endian
    'byteArray(0) = 254: byteArray(1) = 255

' now write the two-byte BOM
Put myFileNumber, 1, byteArray

' redimension your byte array
' note it works even if you don't Redim (go figure) but it's more elegant
I = (LenB(myText) / 2) - 1
ReDim byteArray(I)

' populate the byte array...
byteArray = myText

' ... and write you text AFTER the BOM
Put myFileNumber, 3, byteArray
Close #myFileNumber
End Function
于 2020-08-22T16:30:34.560 回答
1

这是一个 VBA 例程，它将一个字符串作为输入（您的文本），并填充一个字节数组。然后以二进制模式将该数组写入磁盘，确保在前三个字节 (BOM)之后开始写入。

您将需要这些公共变量： byteArray() As Byte, regexUTF8 As String

子测试（）

' 创建 BOM

Dim bom(2) As Byte, someFile As Long

bom(0) = 239: bom(1) = 187: bom(2) = 191

' 写成 utf-8 UTF16toUTF8 "L'élève de l'école"

someFile = FreeFile() Open "MacDisk:test.txt" For Binary As #someFile ' 首先是 BOM Put #someFile, 1, bom ' 然后是 utf-8 文本 Put #someFile, 4, byteArray1 Close #someFile End Sub

Sub UTF16toUTF8(theString As String)

' by Yves Champollion ' 将 VB/VBA 字符串（它们都是 16 位）转换为 byteArray1，utf-8 兼容

    If isStringUTF8(theString) Then Exit Sub

    Dim iLoop As Long, i As Long, k As Long

    k = 0
    ReDim byteArray1(Len(theString) * 4)
    For iLoop = 1 To Len(theString)
        i = AscW(Mid$(theString, iLoop, 1))
        If i < 0 Then i = i + 65536
        If i > -1 And i < 128 Then
            byteArray1(k) = i
            k = k + 1
        ElseIf i >= 128 And i < 2048 Then
            byteArray1(k) = (i \ 64) Or 192
            byteArray1(k + 1) = (i And 63) Or 128
            k = k + 2
        ElseIf i >= 2048 And i < 65536 Then
            byteArray1(k) = (i \ 4096) Or 224
            byteArray1(k + 1) = ((i \ 64) And 63) Or 128
            byteArray1(k + 2) = (i And 63) Or 128
            k = k + 3
        Else
            byteArray1(k) = (i \ 262144) Or 240
            byteArray1(k + 1) = (((i \ 4096) And 63)) Or 128
            byteArray1(k + 2) = ((i \ 64) And 63) Or 128
            byteArray1(k + 3) = (i And 63) Or 128
            k = k + 4
        End If
    Next

    ReDim Preserve byteArray1(k - 1)

End Sub

函数 isStringUTF8(theString As String) As Boolean

    Dim i As Integer, j As Integer, k As Integer

    ' Prime the regex argument
    If Len(regexUTF8) <> 66 Then
        regexUTF8 = "*[" + Space$(62) + "]*"
        For i = 192 To 253
            Mid(regexUTF8, i - 189, 1) = Chr(i)
        Next
    End If

    ' First quick check: any escaping characters?
    If Not theString Like regexUTF8 Then Exit Function

    'longer check: are escaping characters followed by UTF-8 sequences?
    For i = 1 To Len(theString) - 3
        If Asc(Mid(theString, i, 1)) > 192 Then
            k = Asc(Mid(theString, i, 1))
            If k > 193 And k < 220 Then
                If (Asc(Mid(theString, i + 1, 1)) And 128) Then
                    isStringUTF8 = True
                    Exit Function
                End If
            End If
            If k > 223 Then
                If (Asc(Mid(theString, i + 1, 1)) And 128) And (Asc(Mid(theString, i + 2, 1)) And 128) Then
                    isStringUTF8 = True
                    Exit Function
                End If
            End If
            j = j + 1
            If j > 100 Then Exit For
        End If
    Next
End Function
于 2021-07-03T18:06:24.727 回答