Dim fDir As String
Dim wB As Workbook
Dim wS As Worksheet
Dim fPath As String
Dim sPath As String
fPath = "C:\Users\ms-off1\Desktop\temp\"
sPath = "C:\Users\ms-off1\Desktop\temp\"
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
可以.文件1中有VBA代码操作文件2 文件1可以用Thisworkbook.Path来确认路径. |
Sub SaveToCSVs()
Dim fDir As String
Dim fileName As String
Dim wB As Workbook
Dim wS As Worksheet
Dim fPath As String
Dim sPath As String
fPath = ThisWorkbook.Path & "\xls\"
sPath = ThisWorkbook.Path & "\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)
If Right(fDir, 4) = ".xls" Then
fileName = Left(wB.Name, Len(wB.Name) - 4)
End If
If Right(fDir, 5) = ".xlsx" Then
fileName = Left(wB.Name, Len(wB.Name) - 5)
End If
wB.SaveAs sPath & fileName & ".csv"
'MsgBox (wB.Name)
'For Each wS In wB.Sheets
'wS.SaveAs sPath & fileName & ".csv", xlCSV
'Next wS
wB.Close False
Set wB = Nothing
End If
fDir = Dir
On Error GoTo 0
Loop
End Sub