- 在左侧工程资源管理器中双击Sheet1 (Sheet1)打开代码窗口。工程资源管理器如果没有显示,则按ctrl+R就可以显示
-
-
代码窗口中输入下面代码,其中有两行需要自己修改为实际文件来源路径和保存路径。就是开头说到的那两个文件夹位置。
-
Sub SaveToCSVs()
Dim fDir As String
Dim wB As Workbook
Dim wS As Worksheet
Dim fPath As String
Dim sPath As String
fPath = "C:\Users\杜漪漪\Desktop\excle\"
sPath = "C:\Users\杜漪漪\Desktop\转csv\"
fDir = Dir(fPath)
Do While (fDir <> "")
If Right(fDir, 4) = ".xls" Or Right(fDir, 5) = ".xlsx" Then
On Error Resume Next
Set wB = Workbooks.Open(fPath & fDir)
'MsgBox (wB.Name)
For Each wS In wB.Sheets
wS.SaveAs sPath & wB.Name & ".csv", xlCSV
Next wS
wB.Close False
Set wB = Nothing
End If
fDir = Dir
On Error GoTo 0
Loop
End Sub
代码中的 fPath = “C:\Users\Desktop\excle” -定义为需要转换成CSV的Excel源文件。
sPath = “C:\Users\Desktop\转csv”-定义为转换后的CSV文件保存位置。
这两个位置需要自己按实际修改。特别注意:路径需要以\结尾。
写好代码后开始运行。点击菜单栏上的运行,选择运行子过程/用户窗体。