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

Posted 2023-05-07

【中文标题】VBA 另存为 CSV 文件被第一张表覆盖

【英文标题】：VBA Save As CSV File is Overwritten by First Sheet

【发布时间】：2018-07-25 16:41:14

【问题描述】：

我有工作簿，我循环浏览并将每张工作表保存为 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】：

您的代码太大，没有任何好处。我清理了它并纠正了你的错误，还添加了必要的部分，以不向用户询问任何内容：

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

【讨论】：

@Mwspencer 有用吗？如果是，请点击左上角的复选标记选择它作为正确答案