使用 VBA 将 XLSX 转换为 CSV

Question

首先，我在 VBA 方面相当业余，所以我需要你的帮助！

我使用下面的代码将 .xlsx 转换为 .csv 但不知何故字符不适合 see.English 可以，但越南字符不容易看到。

例如，复制此文本“Bạn đánh giá về nhà hàng của chúng toi hôm nay như thế nào?”到 xlsx 文件并使用下面的代码转换为 csv。那么这个字符就是这样显示的"Ba?n ?a?nh gia? vê? nha? ha?ng cu?a chu?ng to?i ho?m nay nhu? thê? na?o?"

任何人都可以帮我解决这个问题！提前谢谢你

Dim fso: set fso = CreateObject("Scripting.FileSystemObject") ' directory in which this script is currently running CurrentDirectory = fso.GetAbsolutePathName(".")

Set folder = fso.GetFolder(CurrentDirectory)

For each file In folder.Files

If fso.GetExtensionName(file) = "xlsx" Then

    pathOut = fso.BuildPath(CurrentDirectory, fso.GetBaseName(file)+".csv")

    Dim oExcel
    Set oExcel = CreateObject("Excel.Application")
    Dim oBook
    Set oBook = oExcel.Workbooks.Open(file)
    oBook.SaveAs pathOut, 6
    oBook.Close False
    oExcel.Quit
End If Next

Answer 1

您必须使用编码 UTF-8。 adostream 辅助这个功能。

Sub SaveXlsToCsvFiles()
    Dim FileName As String
    Dim Ws As Worksheet, Wb As Workbook
    Dim rngDB As Range
    Dim r As Long, c As Long
    Dim pathOut As String
    Dim File As Object, folder As Object

Dim fso: Set fso = CreateObject("Scripting.FileSystemObject") ' directory in which this script is currently running CurrentDirectory = fso.GetAbsolutePathName(".")

'Set folder = fso.GetFolder(CurrentDirectory)
Set folder = fso.GetFolder(ThisWorkbook.Path)
For Each File In folder.Files

    If fso.GetExtensionName(File) = "xlsx" Then
        If File.Name <> ThisWorkbook.Name Then
            pathOut = fso.BuildPath(CurrentDirectory, fso.GetBaseName(File) + ".csv")
            With File
                Set Wb = Workbooks.Open(.ParentFolder & "\" & .Name)
                Set Ws = Wb.Sheets(1)
                With Ws
                    r = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                    c = .Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
                    Set rngDB = .Range("a1", .Cells(r, c))
                End With
                TransToCSV pathOut, rngDB
                Wb.Close (0)
            End With
        End If
    End If
Next
Set fso = Nothing
    MsgBox ("Files Saved Successfully")
End Sub
Sub TransToCSV(myfile As String, rng As Range)

    Dim vDB, vR() As String, vTxt()
    Dim i As Long, n As Long, j As Integer
    Dim objStream
    Dim strTxt As String

    Set objStream = CreateObject("ADODB.Stream")
    vDB = rng
    For i = 1 To UBound(vDB, 1)
        n = n + 1
        ReDim vR(1 To UBound(vDB, 2))
        For j = 1 To UBound(vDB, 2)
            vR(j) = vDB(i, j)
        Next j
        ReDim Preserve vTxt(1 To n)
        vTxt(n) = Join(vR, ",")
    Next i
    strTxt = Join(vTxt, vbCrLf)
    With objStream
        .Charset = "utf-8"
        .Open
        .WriteText strTxt
        .SaveToFile myfile, 2
        .Close
    End With
    Set objStream = Nothing

End Sub

使用 VBA 将 XLSX 转换为 CSV

Convert XSLX to CSV using VBA

excel

vba

xlsx

export-to-csv