提问者:小点点

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


我有工作簿,我遍历并将每个工作表保存为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