将 Excel 范围写入 UTF-8 文本文件

Question

我尝试通过宏将一系列单元格保存为文本文件。下面的代码有效，但我希望它保存为 UTF-8，因为范围内的一些单元格包含字符 enye (ñ):

Sub CreateTxtFiles()
Dim rng As Range
Dim ff As Long
Dim LastRow As Long
Dim i As Long
    LastRow = Range("AU" & Rows.Count).End(xlUp).Row
         
    Open "C:\Users\user1\Desktop\temp\output.txt" For Output As #ff
    
    For i = 2 To LastRow
        Set rng = Range("AU" & i)
        
        Print #ff, "" & rng.Value & ""
        
    Next i
    
    Close #ff
    
End Sub

我在solutions之一看到过这段代码，但由于我是VBA的新手，我不知道如何将这段代码与我目前上面的代码整合：

Dim fsT As Object
Set fsT = CreateObject("ADODB.Stream")
fsT.Type = 2 'Specify stream type - we want To save text/string data.
fsT.Charset = "utf-8" 'Specify charset For the source text data.
fsT.Open 'Open the stream And write binary data To the object
fsT.WriteText "special characters: äöüß"
fsT.SaveToFile sFileName, 2 'Save binary data To disk

如何获取要导出为 UTF-8 文本文件的范围？

Answer 1

请尝试下一种方式：

Sub CreateUTFTxtFile() 'it looks to return UTF-16 LE-BOM
 Dim rng As Range, LastRow As Long, i As Long
 Dim fso As Object, MyFile As Object, boolUnicode As Boolean
 Dim myFileName As String
 
    myFileName = "C:\Users\user1\Desktop\temp\output.txt"
    LastRow = Range("AU" & rows.count).End(xlUp).row
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    boolUnicode = True
    Set MyFile = fso.CreateTextFile(myFileName, False, boolUnicode) 'open the file to write Unicode:
       For i = 2 To LastRow
         MyFile.WriteLine (Range("AU" & i).Value)
       Next i
    MyFile.Close
End Sub

已编辑:

请测试下一个代码。它将创建一个真正的 UTF-8 文本文件。而且代码应该很快：

Private Sub CreateUTFT8tFile() 'UTF-8 BOM for huge files...
 Dim rng As Range, LastRow As Long, i As Long
 Dim fso As Object, MyFile As Object, boolUnicode As Boolean
 Dim myFileName As String, myFileName2 As String, strText As String
 
    myFileName = "C:\Users\user1\Desktop\temp\outputUTF16.txt" 'temporary text container
    myFileName2 = "C:\Users\user1\Desktop\temp\output.txt"
    LastRow = Range("AU" & rows.count).End(xlUp).row
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    boolUnicode = True
    If dir(myFileName) <> "" Then Kill myFileName
    Set MyFile = fso.CreateTextFile(myFileName, False, boolUnicode) 'open the file to write UTF-16:
       For i = 2 To LastRow
         MyFile.WriteLine (Range("AU" & i).Value)
       Next i
    MyFile.Close
    strText = readTextUTF16$(myFileName)   'read UTF-16 file, used as container for the case of huge text content

    With CreateObject("ADODB.Stream")
       .Charset = "utf-8": .Open
        .WriteText strText
        .SaveToFile myFileName2, 2          'convert to UTF-8 BOM
    End With
End Sub
Function readTextUTF16$(f)
    With CreateObject("ADODB.Stream")
        .Charset = "utf-16": .Open
        .LoadFromFile f
        readTextUTF16$ = .ReadText
    End With
End Function

如果您不喜欢UTF-8 BOM，请使用下一个版本：

Sub CreateUTF8TxtFilesNoBOM() 'UTF-8 no BOM
 Dim LastRow As Long, oStream As Object
 Dim myFileName As String, arrTxt, strTxt As String
 
    myFileName = "C:\Users\user1\Desktop\temp\output.txt"
    LastRow = Range("AU" & rows.count).End(xlUp).row
    arrTxt = Application.Transpose(Range("AU2:AU" & LastRow).Value)
    strTxt = Join(arrTxt, vbCrLf)
    
    WriteUTF8WithoutBOM strTxt, myFileName
End Sub
Function WriteUTF8WithoutBOM(strText As String, fileName As String)
  Dim UTFStream As Object, BinaryStream As Object
  With CreateObject("adodb.stream")
     .Type = 2: .Mode = 3: .Charset = "UTF-8"
     .LineSeparator = -1
     .Open: .WriteText strText, 1
     .Position = 3 'skip BOM' !!!
     Set BinaryStream = CreateObject("adodb.stream")
         BinaryStream.Type = 1
         BinaryStream.Mode = 3
         BinaryStream.Open
        'Strips BOM (first 3 bytes)
        .CopyTo BinaryStream
        .Flush
    .Close
  End With
    BinaryStream.SaveToFile fileName, 2
    BinaryStream.Flush
    BinaryStream.Close
End Function

将 Excel 范围写入 UTF-8 文本文件

Write Excel range to UTF-8 text file

excel

vba

character-encoding