我修改了这个从Kutools找到的vba代码,它可以批量转换一个文件夹的XLS和XLSX到CSV。Kutools代码的问题是它不能处理转换多个工作表的工作簿。
所以我写了这个修改:
Sub Button1_Click()
Dim xObjWB As Workbook
Dim xObjWS As Worksheet
Dim xStrEFPath As String
Dim xStrEFFile As String
Dim xObjFD As FileDialog
Dim xObjSFD As FileDialog
Dim xStrSPath As String
Dim xStrCSVFName As String
Dim intFileCount As Integer
Dim TargetFN As String
On Error GoTo EndHandler
If MsgBox("This macro will convert all XLS and XLSX files from one folder to CSVs in another folder." & Chr(13) & Chr(13) & _
"The program will attempt to close all other workbooks before starting the conversion." & Chr(13) & Chr(13) & _
"This process may take a while. You will be notified when the conversion is finished." & Chr(13) & Chr(13) & _
"Click OK to continue. . .", vbOKCancel, "Read Carefully!") = vbCancel Then
GoTo EndHandler
Else
For Each xObjWB In Workbooks
If xObjWB.Name <> ThisWorkbook.Name Then
xObjWB.Close
End If
Next
End If
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
On Error Resume Next
Set xObjFD = Application.FileDialog(msoFileDialogFolderPicker)
xObjFD.AllowMultiSelect = False
xObjFD.Title = "Select a folder which contains Excel files"
If xObjFD.Show <> -1 Then Exit Sub
xStrEFPath = xObjFD.SelectedItems(1) & "\"
Set xObjSFD = Application.FileDialog(msoFileDialogFolderPicker)
xObjSFD.AllowMultiSelect = False
xObjSFD.Title = "Select a folder to locate CSV files"
If xObjSFD.Show <> -1 Then Exit Sub
xStrSPath = xObjSFD.SelectedItems(1) & "\"
xStrEFFile = Dir(xStrEFPath & "*.xls*")
Do While xStrEFFile <> ""
Set xObjWB = Workbooks.Open(Filename:=xStrEFPath & xStrEFFile)
xStrCSVFName = xStrSPath & Left(xStrEFFile, InStr(1, xStrEFFile, ".") - 1)
intFileCount = 0
TargetFN = ""
For Each xObjWS In xObjWB.Sheets
intFileCount = intFileCount + 1
'TargetFN = xStrCSVFName & "_Sheet" & intFileCount & "_" & xObjWS.Name & ".csv"
TargetFN = xStrCSVFName & "_Sheet" & intFileCount & ".csv"
xObjWS.Copy
ActiveWorkbook.SaveAs Filename:=TargetFN, FileFormat:=xlCSV
ActiveWorkbook.Close SaveChanges:=False
Next
xObjWB.Close SaveChanges:=False
xStrEFFile = Dir
Loop
MsgBox "Process Finished!", , ""
EndHandler:
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
我基本上添加了一个循环,循环通过每个工作簿中的每个工作表,以保存为单独的CSV文件。
它工作得非常好,除非源文件名中有中文字符,在这种情况下宏会冻结。
有没有办法让它处理源文件名中的中文字符?
先谢谢你!
1条答案
按热度按时间h79rfbju1#
我使用Excel 2016,实际上,DIR函数似乎成功地将文件名读取为字符串(包括中文字符)。失败的是调用Workbook.open(FilenameString),它报告找不到文件。
我想重命名的文件没有这些中文字符,但到目前为止,我还没有找到一种方法来成功地做到这一点-我必须这样做手动在Windows资源管理器这是一个可怕的变通办法。