将文件夹中的.xlsx文件保存为.csv文件

时间:2019-12-14 12:05:18

标签: excel vba

我尝试使用此脚本将xlsx文件转换为csv。

我希望旧文件位于文件夹中,并且csv文件上的名称必须与xlsx文件完全相同。

我在.之类的csv扩展中额外获得了filename..csv

Sub ConvertCSVToXlsx()

    Dim myfile As String
    Dim oldfname As String, newfname As String
    Dim workfile
    Dim folderName As String

    Application.DisplayAlerts = False
    Application.ScreenUpdating = False

'   Capture name of current file
    myfile = ActiveWorkbook.Name

'   Set folder name to work through
    folderName = "C:\Test\"

'   Loop through all CSV filres in folder
    workfile = Dir(folderName & "*.xlsx")
    Do While workfile <> ""
'       Open CSV file
        Workbooks.Open Filename:=folderName & workfile
'       Capture name of old CSV file
        oldfname = ActiveWorkbook.FullName
'       Convert to XLSX
        newfname = folderName & Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4) & ".CSV"
        ActiveWorkbook.SaveAs Filename:=newfname, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
        ActiveWorkbook.Close
'       Delete old CSV file
        Kill oldfname
        Windows(myfile).Activate
        workfile = Dir()
    Loop

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

End Sub

1 个答案:

答案 0 :(得分:4)

非常接近。 您的评论在代码中有些混乱。

如果要使用left(len()-4),则需要更改部分以添加不带句点的csv。 newfname = oldfname和“ CSV”

只需用saveas行进行编辑

您不会杀死原始工作簿,而是将其从文件夹中删除。

原始工作簿不再打开,因为您将其另存为新文件名。

Sub ConvertCSVToXlsx()

    Dim myfile As String
    Dim oldfname As String, newfname As String
    Dim workfile
    Dim folderName As String
    Dim wb As Workbook
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False

    '   Capture name of current file
    myfile = ActiveWorkbook.Name

    '   Set folder name to work through
    folderName = "C:\New folder\"

    '   Loop through all CSV filres in folder
    workfile = Dir(folderName & "*.xlsx")
    Do While workfile <> ""
        '       Open CSV file
        Workbooks.Open Filename:=folderName & workfile
        Set wb = ActiveWorkbook
        '       Capture name of old CSV file
        oldfname = Left(wb.FullName, Len(wb.FullName) - 4)
        '       Convert to XLSX
        newfname = oldfname & "CSV"
        wb.SaveAs Filename:=newfname, FileFormat:=xlCSV, CreateBackup:=False
        wb.Close
        workfile = Dir()
    Loop

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

End Sub