问题描述
首先,我对VBA相当业余,为什么我需要您的帮助!
First of all, I'm quite amateur on VBA that why i need your help!
我使用下面的代码将.xlsx
转换为.csv
,但是不知该字符如何显示.英语还可以,但越南字符不易看到.
I use the code below to convert .xlsx
to .csv
but somehow the character is not good to see.English is ok but Vietnamese character is not easy to see.
例如,复制此文本Bạnđánhgiávềnhàhàngcủachúngtôihômnaynhư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?".
For example, copy this text" Bạn đánh giá về nhà hàng của chúng tôi hôm nay như thế nào?" to xlsx file and use code below to convert to csv. Then the character is shown like this "Ba?n ?a?nh gia? vê? nha? ha?ng cu?a chu?ng to?i ho?m nay nhu? thê? na?o?"
任何人都可以帮助我!预先谢谢你
Anyone can help me with this! thank you in advance
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
推荐答案
您不必使用Encode UTF-8. adostream辅助此功能.
You havet to use Encode UTF-8. adostream assist this function.
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将XSLX转换为CSV的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持!