excel 如何在VBA中将.txt另存为Unicode或UTF-8

0aydgbwb  于 2022-12-14  发布在  其他
关注(0)|答案(5)|浏览(454)

我希望我的所有文件都保存在Unicode或UTF-8格式,而不是ANSI。
代码如下:

Sub cvelle()
Dim iRow As Long
Dim iFile As Integer
Dim sPath As String
Dim sFile As String

For iRow = 1 To Cells(Rows.Count, "B").End(xlUp).Row
    iFile = FreeFile
    With Rows(iRow)
        sPath = "E:\" & .Range("B1").Value & "\"
        If Len(Dir(sPath, vbDirectory)) = 0 Then MkDir sPath
        sFile = .Range("D1").Value & ".txt"
        
        Open sPath & sFile For Output As #iFile
        Print #iFile, .Range("E1").Value
        Close #iFile
    End With
Next iRow
End Sub

现在,我认为只要插入下面的代码就足够了。

sFile = .Range("D1").Value & ".txt",FileFormat:= _xlUnicodeText

但它给了我一个错误。

c90pui9n

c90pui9n1#

我知道如何创建一个未编码的txt文件。也许你可以尝试读取数据到变量〉创建一个未编码的txt〉写入数据到txt〉保存txt

Dim fso As Object, myTxtFile As ObjectSet 
   fso = CreateObject("Scripting.FileSystemObject")
   Set myTxtFile = fso.CreateTextFile(fileName:="c:\123.txt", OverWrite:=True, Unicode:=True)
46scxncf

46scxncf2#

Function SaveTextToFile(ByVal txt$, ByVal filename$, Optional ByVal encoding$ = "windows-1251") As Boolean
    ' function saves text in txt in filename$
    On Error Resume Next: Err.Clear
    Select Case encoding$

        Case "windows-1251", "", "ansi"
            Set FSO = CreateObject("scripting.filesystemobject")
            Set ts = FSO.CreateTextFile(filename, True)
            ts.Write txt: ts.Close
            Set ts = Nothing: Set FSO = Nothing

        Case "utf-16", "utf-16LE"
            Set FSO = CreateObject("scripting.filesystemobject")
            Set ts = FSO.CreateTextFile(filename, True, True)
            ts.Write txt: ts.Close
            Set ts = Nothing: Set FSO = Nothing

        Case "utf-8noBOM"
            With CreateObject("ADODB.Stream")
                .Type = 2: .Charset = "utf-8": .Open
                .WriteText txt$

                Set binaryStream = CreateObject("ADODB.Stream")
                binaryStream.Type = 1: binaryStream.Mode = 3: binaryStream.Open
                .Position = 3: .CopyTo binaryStream        'Skip BOM bytes
                .flush: .Close
                binaryStream.SaveToFile filename$, 2
                binaryStream.Close
            End With

        Case Else
            With CreateObject("ADODB.Stream")
                .Type = 2: .Charset = encoding$: .Open
                .WriteText txt$
                .SaveToFile filename$, 2        ' saving in coding that you need
                .Close
            End With
    End Select
    SaveTextToFile = Err = 0: DoEvents
End Function
fiei3ece

fiei3ece3#

我个人在工作中使用它,因为一些pl报告有一大堆格式,为了进行调整,你需要它。这里是一个函数,用于读取

Function LoadTextFromTextFile(ByVal filename$, Optional ByVal encoding$) As String
    ' functions loads in code  Charset$ from filename$
    On Error Resume Next: Dim txt$
    If Trim(encoding$) = "" Then encoding$ = "windows-1251"
    With CreateObject("ADODB.Stream")
        .Type = 2:
        If Len(encoding$) Then .Charset = encoding$
        .Open
        .LoadFromFile filename$        'load data from file 
        LoadTextFromTextFile = .ReadText        ' read text
        .Close
    End With
End Function
oyjwcjzk

oyjwcjzk4#

希望这可以保存一些时间:

Sub ExportToTxt()
    Dim fileStream As Object
    Set fileStream = CreateObject("ADODB.Stream")
    fileStream.Charset = "utf-8"
    fileStream.Open

    Dim rangeToExport As Range
    Set rangeToExport = Worksheets("BPC-Processed").Range("A1").CurrentRegion

    Dim firstCol, lastCol, firstRow, lastRow As Integer
    firstCol = rangeToExport.Columns(1).Column
    lastCol = firstCol + rangeToExport.Columns.Count - 1
    firstRow = rangeToExport.Rows(1).row
    lastRow = firstRow + rangeToExport.Rows.Count - 1

    Dim r, c As Integer
    Dim str As String
    Dim delimiter As String
    For r = firstRow To lastRow
        str = ""
        For c = firstCol To lastCol
            If c = 1 Then
                delimiter = ""
            Else
                delimiter = vbTab ' tab
            End If
            str = str & delimiter & rangeToExport.Cells(r, c).Value
        Next c
        fileStream.WriteText str & vbCrLf ' vbCrLf: linebreak
    Next r

    Dim filePath As String
    filePath = Application.ThisWorkbook.Path & "\BPC-Processed.txt"
    fileStream.SaveToFile filePath, 2 ' 2: Create Or Update
    fileStream.Close
End Sub
ijxebb2r

ijxebb2r5#

我没有输入一堆代码,而是找到了使用Unicode作为默认编码的方法:

1. Right click -> New -> Text Document 
 2. Open "New Text Document.txt". Do NOT type anything! 
 3. Go to "File -> Save As... " and choose UniCode under "Encoding:", press     "Save" and overwrite existing file. Close the file. 
 4. Rename "New Text Document.txt" to "UniCode.txt" 
 5. Copy "UniCode.txt" to "C:\WINDOWS\SHELLNEW" 
 6. Open Regedit and Navigate to HKEY_CLASSES_ROOT\.txt\ShellNew 
 7. Right click in the right window -> New -> "String Value" and rename it to  "FileName". 
 8. Double click on "FileName" and put "UniCode.txt" into "Value Data". 
 9. press OK It's finished.

感谢所有人!

相关问题