以与当前打开的 CSV 相同的名称保存 CSV

Question

我有一个宏，它在 CSV 上运行与个人工作簿不同的循环宏（无需打开它），并且应该使用相同的名称重新保存文档。

我在尝试保存时收到此错误。

运行时错误“1004”：
您不能使用与另一个打开的工作簿或加载项相同的名称保存此工作簿。在保存之前选择其他名称或关闭其他工作簿或加载项。

我需要这个，因为有一个工具可以查找此文档名称。

这是打开 csv 并运行循环宏（不打开 Excel）的宏。

Sub ExcelMacroExample() 
    Dim xlApp 
    Dim xlBook 

    Set xlApp = CreateObject("Excel.Application") 
    Set xlBook = xlApp.Workbooks.Open("F:\Folder\specific name.csv", 0, True) 
    xlapp.workbooks.open("C:\Users\name\AppData\Roaming\Microsoft\Excel\XLSTART \Personal.xlsb")
    xlApp.Run "Personal.xlsb!LoopColumnC "
    xlApp.Quit 

    Set xlBook = Nothing 
    Set xlApp = Nothing 
End Sub

LoopColumnC 的宏是它尝试保存的位置。

Sub LoopColumnC()
    '
    ' LoopColumnC Macro
    '

    '
    'This is to disregard any popups.
    Application.DisplayAlerts = False
    'This is the actual loop. Works just fine. 
    Dim lastRow As Long
    lastRow = Cells(Rows.Count, 3).End(xlUp).Row
    For i = 2 To lastRow
        If Cells(i, 3).Value = 1 Then Cells(i, 3).Value = Cells(i - 1, 3).Value
      Next i

    'Here is where it errors out because the file it is trying to save as is already opened in the background. 
    ThisWorkbook.SaveAs "F:\Folder\specific name.csv",

    Application.DisplayAlerts = True
    
End Sub

Answer 1

您应该修改代码以将工作表对象直接传递给被调用的宏 - 不要依赖 Activesheet 等。

Sub ExcelMacroExample() 
    Dim xlApp 
    Dim xlBook

    Set xlApp = CreateObject("Excel.Application") 
    'if you want to save with the same name then you can't open as read-only...
    Set xlBook = xlApp.Workbooks.Open("F:\Folder\specific name.csv", 0, True) 
    xlapp.workbooks.open("C:\Users\name\AppData\Roaming\Microsoft\Excel\XLSTART \Personal.xlsb")
    xlApp.Run "Personal.xlsb!LoopColumnC", xlBook.Worksheets(1) '<< passes the sheet

    xlBook.Close '<<
    xlApp.Quit 

    Set xlBook = Nothing 
    Set xlApp = Nothing 
End Sub

您的处理宏接收工作表对象：

'gets a worksheet object from the caller
Sub LoopColumnC(ws As Worksheet)
  
    
    Dim lastRow As Long
    'operate on the provided worksheet
    lastRow = ws.Cells(ws.Rows.Count, 3).End(xlUp).Row
    For i = 2 To lastRow
        If ws.Cells(i, 3).Value = 1 Then 
            ws.Cells(i, 3).Value = ws.Cells(i - 1, 3).Value
        End If
    Next i

    Application.DisplayAlerts = False
    ws.Parent.SaveAs "F:\Folder\specific name.csv" 'ws.Parent = workbook
    Application.DisplayAlerts = True
    
End Sub