VBA另存为CSV文件被第一张纸覆盖

时间:2018-07-25 16:41:14

标签: excel vba csv save-as

我有工作簿,我循环浏览并将每个工作表另存为csv。问题是循环完成时Excel提示我保存。如果单击“保存”,则excel工作簿打开的任何工作表都将覆盖最后一个工作表。

如果单击“不保存”,则所有内容均会保存正确的数据,但我不能每次都依靠用户单击“不保存”,因此我需要查找代码写在哪里数据保存时。

如何防止csv表被覆盖?

Sub LipperFormat()

'Create Workbook
Dim wb As Workbook

'Get FilePath
Dim wbActive As Workbook
Set wbActive = ActiveWorkbook
Dim wsActive As Worksheet
Set wsActive = wbActive.Worksheets(1)

'Get File Path
Dim filePath As String
Dim rngActive As Range
Set rngActive = wsActive.Cells(1, 2)
filePath = rngActive.Value

'Open File
Set wb = Workbooks.Open(filePath)

'Create Copy of file and CSV
Dim copyFilePath As String
Dim fileExtension As String: fileExtension = "_OG.xlsx"

copyFilePath = Left(filePath, Len(filePath) - 5) + fileExtension

wb.SaveCopyAs copyFilePath

'Loop through worksheets
Dim WS_Count As Integer
Dim i As Integer

WS_Count = wb.Worksheets.Count

For i = 1 To WS_Count

    Dim col As Integer
    Dim ws As Worksheet
    Set ws = wb.Sheets(i)

    'Save As CSV
    Dim sheetName As String: sheetName = ws.Name
    Dim csvFilePath As String
    Dim csvSheet As Worksheet
    cvsFilePath = Left(filePath, Len(filePath) - 5) + "__" + sheetName

    'ws.Name = sheetName
    ws.SaveAs FileName:=cvsFilePath, FileFormat:=xlCSV, CreateBackup:=False

Next i

'wb.Save
wb.Close

End Sub

1 个答案:

答案 0 :(得分:2)

您的代码太大,没有任何好处。我清理了它并纠正了您的错误,还添加了一些必要的内容,以免用户询问任何内容:

Sub LipperFormat()
    Dim filePath As String
    Dim csvFileName As String
    Dim ws As Worksheet
    Dim wb As Workbook

    Application.DisplayAlerts = False

    'define parameters
    Set wb = ThisWorkbook
    Set ws = wb.Worksheets(1) 'it is better to define it with the name, not with its index
    filePath = ws.Cells(1, 2).Value


    'Open File
    Set wb = Workbooks.Open(Filename:=filePath, ReadOnly:=True)

    'loop and save as csv
    For Each ws In wb.Worksheets
        csvFileName = wb.Path & "\" & Left(wb.Name, Len(wb.Name) - 5) & "__" & ws.Name
        ws.Copy
        ActiveWorkbook.SaveAs Filename:=csvFileName, FileFormat:=xlCSV, CreateBackup:=True
        ActiveWorkbook.Close
    Next ws

    'close WB
    wb.Close

    Application.DisplayAlerts = True
End Sub