首先,我对VBA非常讨厌我为什么需要你的帮助!
我使用下面的代码将.xlsx
转换为.csv
但不知何故该角色不太好看。英语很好但是越南字符不容易看到。
例如,复制此文本“Bạnđánhgiávềnhàhàngcủachúngtônhônmaynhư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
答案 0 :(得分:3)
您必须使用Encode 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