使用VBA將XSLX轉換爲CSV

Question

首先，我非常喜歡VBA，爲什麼我需要你的幫助！

我使用下面的代碼將.xlsx轉換爲.csv，但不知怎的，角色不好看。英語是好的，但越南的字符不容易看到。

例如，複製本文「Bạnđánhgiávềnhàhàngcủachúngtôihômnaynhưthếnào？」到xlsx文件並使用下面的代碼轉換爲csv。然後，這個角色就會顯示出來，「這是一個什麼樣的事情？」這個角色是如何展示給你的？

任何人都可以幫助我！提前謝謝你

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