VBA ActiveWorkbook.Saveas 运行时错误 1004

Posted 2023-03-06

【中文标题】VBA ActiveWorkbook.Saveas 运行时错误 1004

【英文标题】：VBA ActiveWorkbook.Saveas runtime error 1004

【发布时间】：2016-12-28 10:37:29

【问题描述】：

我是 VBA 新手，正在尝试从 ws 复制到 wscsv 并将后者另存为 .csv 文件。以下是我的子程序。

我遇到了：

运行时错误 1004：应用程序未定义

在这一行：

ActiveWorkbook.SaveAs Filename:=savedirectory, FileFormat:=xlCSV, ConflictResolution:=Excel.XlSaveConflictResolution.xlLocalSessionChanges  

csvworkbook = ActiveWorkbook.Name

我的代码

Sub AddNewWorkbook1(ws As Worksheet)

  ws.Activate
  MsgBox ("adding new workbook for" & ws.Name)
  Dim wscsv As Excel.Workbook
  Dim savedirectory As String
  Dim currentworkbook As String
  Dim csvworkbook As String
  currentworkbook = ws.Name

  savedirectory = '/Users/Desktop/Magnum/' & currentworkbook

  Dim lrow As Long
  lrow = Columns("A").End(xlDown).Row

  Workbooks.Add
  DisplayAlerts = False
  ActiveWorkbook.SaveAs (Filename:=savedirectory, FileFormat:=xlCSV, ConflictResolution:=Excel.XlSaveConflictResolution.xlLocalSessionChanges)

  csvworkbook = ActiveWorkbook.Name

  Set wscsv = ActiveWorkbook
  MsgBox ("Entering copying")

  ws.Range(ws.Cells(2, 1), ws.Cells(lrow, 4)).Copy
  wscsv.Sheets(1).Range("A1").PasteSpecial xlPasteValues
  ws.Range(ws.Cells(2, "H"), ws.Cells(lrow, "H")).Copy
  wscsv.Sheets(1).Range("E1").PasteSpecial xlPasteValues
  ws.Range(ws.Cells(2, "E"), ws.Cells(lrow, "E")).Copy
  wscsv.Sheets(1).Range("F1").PasteSpecial xlPasteValues
  ws.Range(ws.Cells(2, "I"), ws.Cells(lrow, "I")).Copy
  wscsv.Sheets(1).Range("G1").PasteSpecial xlPasteValues
  lrow = wscsv.Sheets(1).Columns("A").End(xlDown).Row
  wscsv.Sheets(1).Range(wscsv.Sheets(1).Cells(2, 1),    wscsv.Sheets(1).Cells(lrow, 1)).NumberFormat = "mm/dd/yyyy"
  wscsv.Sheets(1).Range("A1").Value = "Date"
  wscsv.Sheets(1).Range("B1").Value = "open"
  wscsv.Sheets(1).Range("C1").Value = "high"
  wscsv.Sheets(1).Range("D1").Value = "low"
  wscsv.Sheets(1).Range("E1").Value = "close"
  wscsv.Sheets(1).Range("F1").Value = "volume"
  wscsv.Sheets(1).Range("G1").Value = "cap"
  wscsv.Save
  wscsv.Close

  MsgBox ("Copying complete")

  End Sub

【问题讨论】：

是currentworkbook 还是CSV？ ***.com/questions/17173898/…

不，不是。它是一个 .xlsx。

【参考方案1】：

解决您的错误行，只需使用：

ActiveWorkbook.SaveAs Filename:=savedirectory, FileFormat:=xlCSV, ConflictResolution:=2

(ConflictResolution = 2, 等于 xlLocalSessionChanges, 阅读这里: https://msdn.microsoft.com/en-us/library/office/ff194803.aspx

但是，您可以通过不使用 ws.Activate、ActiveWorkbook 和 csvworkbook = ActiveWorkbook.Name 来改进您的代码。您可以直接将您的wscsv（定义为工作簿）分配给新创建的工作簿。请参阅下面的代码如何引用所有对象。

代码

Option Explicit

Sub AddNewWorkbook1(ws As Worksheet)

MsgBox ("adding new workbook for " & ws.Name)

Dim wscsv As Workbook
Dim savedirectory As String
Dim currentworkbook As String
Dim csvworkbook As String

currentworkbook = ws.Name
savedirectory = "Your Path" & "\" & ws.Name

Dim lrow As Long
lrow = ws.Columns("A").End(xlDown).Row

Set wscsv = Workbooks.Add
DisplayAlerts = False

wscsv.SaveAs Filename:=savedirectory, FileFormat:=xlCSV, ConflictResolution:=2
csvworkbook = wscsv.Name

MsgBox ("Entering copying")

' do the rest of your copy >> paste 

End Sub

【讨论】：

谢谢！但它仍然不起作用并给出同样的错误。我在 MacBook Air 上运行它。有可能是原因吗？

它。可能是，但我有一台电脑，所以我无法帮助你调试

【参考方案2】：

ActiveWorkbook.SaveAs Filename:=savedirectory, FileFormat:=xlCSV, ConflictResolution:=xlLocalSessionChanges

你可以试试这个方法吗？它对我有用。

【讨论】：

不行，还是不行，是不是因为我用的是Mac来运行这个？