尝试将 XLSM 另存为 CSV 时出现 "method saveas of object _workbook failed" 错误
Getting "method saveas of object _workbook failed" error while trying to save an XLSM as CSV
我正在尝试将启用宏的 Excel 工作簿另存为 csv 文件，覆盖旧的（下面我不得不更改文件夹的名称和 Sheet，但是这似乎不是问题）。
Sub SaveWorksheetsAsCsv()
Dim SaveToDirectory As String
Dim CurrentWorkbook As String
Dim CurrentFormat As Long
CurrentWorkbook = ThisWorkbook.FullName
CurrentFormat = ThisWorkbook.FileFormat
SaveToDirectory = "\MyFolder\"
Application.DisplayAlerts = False
Application.AlertBeforeOverwriting = False
Sheets("My_Sheet").Copy
ActiveWorkbook.SaveAs Filename:=SaveToDirectory & "My_Sheet" & ".csv", FileFormat:=xlCSV
ActiveWorkbook.Close SaveChanges:=False
ThisWorkbook.Activate
ThisWorkbook.SaveAs Filename:=CurrentWorkbook, FileFormat:=CurrentFormat
Application.DisplayAlerts = True
Application.AlertBeforeOverwriting = True
End Sub
有时会失败
Runtime Error 1004: method saveas of object _workbook failed**)
调试器指出：
ActiveWorkbook.SaveAs Filename:=SaveToDirectory & "My_Sheet" & ".csv", FileFormat:=xlCSV
我用谷歌搜索，我尝试过的一些解决方案是：
- 指定目录为字符串
- 避免在文件名或文件夹中使用任何特殊字符（见 here）
- 复制粘贴工作表作为值，然后将其保存为 .csv（见 here）
- 使用 .csv 代码编号指定文件格式（见 here）
- Disabling/Re-enabling 一些警报
- 在 ActiveWorkbook.SaveAs 行中添加其他字段，关于密码、创建备份等
不过，它可能 运行 连续正确多达 50-60 次，然后在某个时候再次失败。
任何建议，除了停止使用 VBA/Excel 完成此任务，这将很快发生，但我现在不能。
编辑：感谢 Degustaf 建议解决。我只对 Degustaf 的建议代码做了两处更改：
ThisWorkbook.Sheets 而不是 CurrentWorkbook.SheetsFileFormat:=6 而不是 FileFormat:=xlCSV（显然更稳健
Excel)
Sub SaveWorksheetsAsCsv()
Dim SaveToDirectory As String
Dim CurrentWorkbook As String
Dim CurrentFormat As Long
Dim TempWB As Workbook
Set TempWB = Workbooks.Add
CurrentWorkbook = ThisWorkbook.FullName
CurrentFormat = ThisWorkbook.FileFormat
SaveToDirectory = "\MyFolder\"
Application.DisplayAlerts = False
Application.AlertBeforeOverwriting = False
ThisWorkbook.Sheets("My_Sheet").Copy Before:=TempWB.Sheets(1)
ThisWorkbook.Sheets("My_Sheet").SaveAs Filename:=SaveToDirectory & "My_Sheet" & ".csv", FileFormat:=6
TempWB.Close SaveChanges:=False
ThisWorkbook.SaveAs Filename:=CurrentWorkbook, FileFormat:=CurrentFormat
ActiveWorkbook.Close SaveChanges:=False
Application.DisplayAlerts = True
Application.AlertBeforeOverwriting = True
End Sub
我通常发现 ActiveWorkbook 是这些情况下的问题所在。我的意思是，不知何故您没有选择该工作簿（或任何其他工作簿），并且 Excel 不知道该怎么做。不幸的是，由于 copy 没有 return 任何东西（复制的作品 sheet 会很好），这是解决此问题的标准方法。
所以，我们可以解决这个问题，因为我们如何将这个 sheet 复制到一个新的工作簿，并获得对该工作簿的引用。我们可以做的是创建新的工作簿，然后复制 sheet:
Dim wkbk as Workbook
Set Wkbk = Workbooks.Add
CurrentWorkbook.Sheets("My_Sheet").Copy Before:=Wkbk.Sheets(1)
Wkbk.SaveAs Filename:=SaveToDirectory & "My_Sheet" & ".csv", FileFormat:=xlCSV
Wkbk.Close SaveChanges:=False
或者，在这种情况下还有更好的方法：WorkSheet支持SaveAs方法。无需复制。
CurrentWorkbook.Sheets("My_Sheet").SaveAs Filename:=SaveToDirectory & "My_Sheet" & ".csv", FileFormat:=xlCSV
如果工作簿保持打开状态，但您的代码中已有该名称，我会警告您之后将工作簿重新保存为原来的名称。
尝试将路径和 CSV 文件名组合成一个字符串变量并删除 .csv；由 FileFormat 处理。路径必须是绝对路径，以驱动器号或服务器名称开头：
Dim strFullFileName as String
strFullFileName = "C:\My Folder\My_Sheet"
如果在服务器上那么它看起来像这样：
strFullFileName = "\ServerName\ShareName\My Folder\My_Sheet"
将 ServerName 替换为您的服务器名称，将 ShareName 替换为您的网络共享名称，例如\data101\Accounting\My Folder\My_Sheet
ActiveWorkbook.SaveAs Filename:=strFullFileName,FileFormat:=xlCSVMSDOS, CreateBackup:=False
这是一年前的事了，但我会为未来的读者添加一些内容
您不会在 Excel 帮助中找到很多关于 运行 时错误 1004 的文档，因为 Microsoft 不认为它是 Excel 错误。
上面的答案是 100% 有效的，但有时它有助于了解导致问题的原因，这样您就可以避免它、更早地修复它或更容易地修复它。
事实上，这是一个间歇性故障，通过保存完整路径和文件名来修复它告诉我，您的宏可能试图在自动文件后将 .xlsb 文件保存到自动恢复目录恢复。
或者，您可能自己编辑了文件的路径或文件名。
您可以检查路径和文件名：-
MsgBox ThisWorkbook.FullName
您应该会在消息框中看到类似这样的内容。
C:\Users\Mike\AppData\Roaming\Microsoft\Excel\DIARY(版本 1).xlxb
如果是这样，解决方案是（如上所述）将您的文件保存到正确的路径和文件名。这可以通过 VBA 或手动完成。
我现在习惯于在执行任何自动恢复操作后使用正确的路径和文件名手动保存文件，因为这需要几秒钟，而且我发现它更快（如果这不是每天发生的话）。这样，宏就不会遇到你运行这个故障了。请记住，虽然我的习惯是在恢复后立即将 .xlxb 文件手动保存为 .xlsm 文件，但这对您交给工作sheet 的新手没有帮助。
关于超链接的说明
出现此错误后：如果您的作品中有超链接sheet，很可能是使用 Ctrl+k 创建的，你会得到像 "AppData\Roaming\Microsoft\", "\AppData\Roaming\", "../../AppData/Roaming/"or "...\My documents\My documents\ " 在文件恢复后的多个超链接中。您可以通过将超链接附加到文本框或使用 HYPERLINK 函数生成它们来避免这些。
识别和修复它们有点复杂
首先，检查超链接并确定错误字符串和每个错误的正确字符串。随着时间的推移，我找到了几个。
Excel 没有在 'Go To Special' 菜单中提供工具来搜索使用 Ctrl+k[= 创建的超链接71=]。
您可以自动识别辅助列中的错误超链接，例如 Z 列并使用公式
=OR(ISNUMBER(SEARCH("Roaming", Link2Text($C2),1)),ISNUMBER(SEARCH("Roaming", Link2Text($D2),1)))
其中 Link2Text 是 UDF
函数 Link2Text(rng As Range) As String
' 不要停用。
' 在 Z 列中找到包含 'roaming' 的超链接。
' Identify affected hyperlinks
If rng(1).Hyperlinks.Count Then
Link2Text = rng.Hyperlinks(1).Address
End If
End Function
我的VBA更正错误如下
子Replace_roaming()
' Select 正确的 sheet
工作表("DIARY").Select
Dim hl As Hyperlink
For Each hl In ActiveSheet.Hyperlinks
hl.Address = Replace(hl.Address, "AppData\Roaming\Microsoft\", "")
Next
For Each hl In ActiveSheet.Hyperlinks
hl.Address = Replace(hl.Address, "AppData\Roaming\", "")
Next
For Each hl In ActiveSheet.Hyperlinks
hl.Address = Replace(hl.Address, "../../AppData/Roaming/", "..\..\My documents\")
Next
For Each hl In ActiveSheet.Hyperlinks
hl.Address = Replace(hl.Address, "..\..\My documents\My documents\", "..\..\My documents\")
Next
Application.Run "Recalc_BT"
' Move down one active row to get off the heading
ActiveCell.Offset(1, 0).Select
' Check active row location
If ActiveCell.Row = 1 Then
ActiveCell.Offset(1, 0).Select
End If
' Recalc active row
ActiveCell.EntireRow.Calculate
' Notify
MsgBox "Replace roaming is now complete."
End Sub
我还建议您养成定期备份的习惯，不要只依赖自动恢复。如果失败，则自上次完整备份以来您将一无所有。
虽然工作sheet经常进行脆弱的备份，例如每小时或在任何重要的新数据导入之后。
以下快捷方式将在几秒钟内备份您的工作sheet：Ctrl+O、[突出显示文件名]、 Ctrl+C, Ctrl+V, [ X ].定期备份允许您立即转到最近的备份，而不必从昨晚的备份文件中恢复，尤其是当您必须请求其他人执行此操作时。
我遇到了类似的问题，但对我来说，问题是我是根据从工作簿中提取的字符串创建文件名的，有时这些字符串会包含不能出现在文件名中的字符。
删除这些字符对我有用！
距离上次回答已经有一段时间了，但我想分享一下我今天的经验：
经过几周的可靠操作，我 运行 突然陷入同样的错误，而保存工作簿的代码部分没有任何更改。
感谢之前的回答，我从一个简单的
更新了我的 saveas 语句
wb.saveas strfilename
至
wb.saveas Filename:=strfilename, Fileformat:= xlWorkbookDefault
瞧瞧：它又成功了。
有时 Microsoft 应用程序的行为真的很奇怪运行ge...
对我来说，尽管将其设置为“自动”，但并非所有公式都被计算出来，这是一个问题。我按了左下角的计算 100 次，然后神奇地起作用了。
我正在尝试将启用宏的 Excel 工作簿另存为 csv 文件，覆盖旧的（下面我不得不更改文件夹的名称和 Sheet，但是这似乎不是问题）。
Sub SaveWorksheetsAsCsv()
Dim SaveToDirectory As String
Dim CurrentWorkbook As String
Dim CurrentFormat As Long
CurrentWorkbook = ThisWorkbook.FullName
CurrentFormat = ThisWorkbook.FileFormat
SaveToDirectory = "\MyFolder\"
Application.DisplayAlerts = False
Application.AlertBeforeOverwriting = False
Sheets("My_Sheet").Copy
ActiveWorkbook.SaveAs Filename:=SaveToDirectory & "My_Sheet" & ".csv", FileFormat:=xlCSV
ActiveWorkbook.Close SaveChanges:=False
ThisWorkbook.Activate
ThisWorkbook.SaveAs Filename:=CurrentWorkbook, FileFormat:=CurrentFormat
Application.DisplayAlerts = True
Application.AlertBeforeOverwriting = True
End Sub
有时会失败
Runtime Error 1004: method saveas of object _workbook failed**)
调试器指出：
ActiveWorkbook.SaveAs Filename:=SaveToDirectory & "My_Sheet" & ".csv", FileFormat:=xlCSV
我用谷歌搜索，我尝试过的一些解决方案是：
- 指定目录为字符串
- 避免在文件名或文件夹中使用任何特殊字符（见 here）
- 复制粘贴工作表作为值，然后将其保存为 .csv（见 here）
- 使用 .csv 代码编号指定文件格式（见 here）
- Disabling/Re-enabling 一些警报
- 在 ActiveWorkbook.SaveAs 行中添加其他字段，关于密码、创建备份等
不过，它可能 运行 连续正确多达 50-60 次，然后在某个时候再次失败。
任何建议，除了停止使用 VBA/Excel 完成此任务，这将很快发生，但我现在不能。
编辑：感谢 Degustaf 建议解决。我只对 Degustaf 的建议代码做了两处更改：
ThisWorkbook.Sheets而不是CurrentWorkbook.SheetsFileFormat:=6而不是FileFormat:=xlCSV（显然更稳健 Excel) 的不同版本
Sub SaveWorksheetsAsCsv()
Dim SaveToDirectory As String
Dim CurrentWorkbook As String
Dim CurrentFormat As Long
Dim TempWB As Workbook
Set TempWB = Workbooks.Add
CurrentWorkbook = ThisWorkbook.FullName
CurrentFormat = ThisWorkbook.FileFormat
SaveToDirectory = "\MyFolder\"
Application.DisplayAlerts = False
Application.AlertBeforeOverwriting = False
ThisWorkbook.Sheets("My_Sheet").Copy Before:=TempWB.Sheets(1)
ThisWorkbook.Sheets("My_Sheet").SaveAs Filename:=SaveToDirectory & "My_Sheet" & ".csv", FileFormat:=6
TempWB.Close SaveChanges:=False
ThisWorkbook.SaveAs Filename:=CurrentWorkbook, FileFormat:=CurrentFormat
ActiveWorkbook.Close SaveChanges:=False
Application.DisplayAlerts = True
Application.AlertBeforeOverwriting = True
End Sub
我通常发现 ActiveWorkbook 是这些情况下的问题所在。我的意思是，不知何故您没有选择该工作簿（或任何其他工作簿），并且 Excel 不知道该怎么做。不幸的是，由于 copy 没有 return 任何东西（复制的作品 sheet 会很好），这是解决此问题的标准方法。
所以，我们可以解决这个问题，因为我们如何将这个 sheet 复制到一个新的工作簿，并获得对该工作簿的引用。我们可以做的是创建新的工作簿，然后复制 sheet:
Dim wkbk as Workbook
Set Wkbk = Workbooks.Add
CurrentWorkbook.Sheets("My_Sheet").Copy Before:=Wkbk.Sheets(1)
Wkbk.SaveAs Filename:=SaveToDirectory & "My_Sheet" & ".csv", FileFormat:=xlCSV
Wkbk.Close SaveChanges:=False
或者，在这种情况下还有更好的方法：WorkSheet支持SaveAs方法。无需复制。
CurrentWorkbook.Sheets("My_Sheet").SaveAs Filename:=SaveToDirectory & "My_Sheet" & ".csv", FileFormat:=xlCSV
如果工作簿保持打开状态，但您的代码中已有该名称，我会警告您之后将工作簿重新保存为原来的名称。
尝试将路径和 CSV 文件名组合成一个字符串变量并删除 .csv；由 FileFormat 处理。路径必须是绝对路径，以驱动器号或服务器名称开头：
Dim strFullFileName as String
strFullFileName = "C:\My Folder\My_Sheet"
如果在服务器上那么它看起来像这样：
strFullFileName = "\ServerName\ShareName\My Folder\My_Sheet"
将 ServerName 替换为您的服务器名称，将 ShareName 替换为您的网络共享名称，例如\data101\Accounting\My Folder\My_Sheet
ActiveWorkbook.SaveAs Filename:=strFullFileName,FileFormat:=xlCSVMSDOS, CreateBackup:=False
这是一年前的事了，但我会为未来的读者添加一些内容
您不会在 Excel 帮助中找到很多关于 运行 时错误 1004 的文档，因为 Microsoft 不认为它是 Excel 错误。
上面的答案是 100% 有效的，但有时它有助于了解导致问题的原因，这样您就可以避免它、更早地修复它或更容易地修复它。
事实上，这是一个间歇性故障，通过保存完整路径和文件名来修复它告诉我，您的宏可能试图在自动文件后将 .xlsb 文件保存到自动恢复目录恢复。
或者，您可能自己编辑了文件的路径或文件名。
您可以检查路径和文件名：- MsgBox ThisWorkbook.FullName
您应该会在消息框中看到类似这样的内容。
C:\Users\Mike\AppData\Roaming\Microsoft\Excel\DIARY(版本 1).xlxb
如果是这样，解决方案是（如上所述）将您的文件保存到正确的路径和文件名。这可以通过 VBA 或手动完成。
我现在习惯于在执行任何自动恢复操作后使用正确的路径和文件名手动保存文件，因为这需要几秒钟，而且我发现它更快（如果这不是每天发生的话）。这样，宏就不会遇到你运行这个故障了。请记住，虽然我的习惯是在恢复后立即将 .xlxb 文件手动保存为 .xlsm 文件，但这对您交给工作sheet 的新手没有帮助。
关于超链接的说明
出现此错误后：如果您的作品中有超链接sheet，很可能是使用 Ctrl+k 创建的，你会得到像 "AppData\Roaming\Microsoft\", "\AppData\Roaming\", "../../AppData/Roaming/"or "...\My documents\My documents\ " 在文件恢复后的多个超链接中。您可以通过将超链接附加到文本框或使用 HYPERLINK 函数生成它们来避免这些。
识别和修复它们有点复杂
首先，检查超链接并确定错误字符串和每个错误的正确字符串。随着时间的推移，我找到了几个。
Excel 没有在 'Go To Special' 菜单中提供工具来搜索使用 Ctrl+k[= 创建的超链接71=]。
您可以自动识别辅助列中的错误超链接，例如 Z 列并使用公式
=OR(ISNUMBER(SEARCH("Roaming", Link2Text($C2),1)),ISNUMBER(SEARCH("Roaming", Link2Text($D2),1)))
其中 Link2Text 是 UDF
函数 Link2Text(rng As Range) As String ' 不要停用。 ' 在 Z 列中找到包含 'roaming' 的超链接。
' Identify affected hyperlinks
If rng(1).Hyperlinks.Count Then
Link2Text = rng.Hyperlinks(1).Address
End If
End Function
我的VBA更正错误如下
子Replace_roaming()
' Select 正确的 sheet 工作表("DIARY").Select
Dim hl As Hyperlink
For Each hl In ActiveSheet.Hyperlinks
hl.Address = Replace(hl.Address, "AppData\Roaming\Microsoft\", "")
Next
For Each hl In ActiveSheet.Hyperlinks
hl.Address = Replace(hl.Address, "AppData\Roaming\", "")
Next
For Each hl In ActiveSheet.Hyperlinks
hl.Address = Replace(hl.Address, "../../AppData/Roaming/", "..\..\My documents\")
Next
For Each hl In ActiveSheet.Hyperlinks
hl.Address = Replace(hl.Address, "..\..\My documents\My documents\", "..\..\My documents\")
Next
Application.Run "Recalc_BT"
' Move down one active row to get off the heading
ActiveCell.Offset(1, 0).Select
' Check active row location
If ActiveCell.Row = 1 Then
ActiveCell.Offset(1, 0).Select
End If
' Recalc active row
ActiveCell.EntireRow.Calculate
' Notify
MsgBox "Replace roaming is now complete."
End Sub
我还建议您养成定期备份的习惯，不要只依赖自动恢复。如果失败，则自上次完整备份以来您将一无所有。
虽然工作sheet经常进行脆弱的备份，例如每小时或在任何重要的新数据导入之后。
以下快捷方式将在几秒钟内备份您的工作sheet：Ctrl+O、[突出显示文件名]、 Ctrl+C, Ctrl+V, [ X ].定期备份允许您立即转到最近的备份，而不必从昨晚的备份文件中恢复，尤其是当您必须请求其他人执行此操作时。
我遇到了类似的问题，但对我来说，问题是我是根据从工作簿中提取的字符串创建文件名的，有时这些字符串会包含不能出现在文件名中的字符。 删除这些字符对我有用！
距离上次回答已经有一段时间了，但我想分享一下我今天的经验：
经过几周的可靠操作，我 运行 突然陷入同样的错误，而保存工作簿的代码部分没有任何更改。
感谢之前的回答，我从一个简单的
更新了我的 saveas 语句wb.saveas strfilename
至
wb.saveas Filename:=strfilename, Fileformat:= xlWorkbookDefault
瞧瞧：它又成功了。
有时 Microsoft 应用程序的行为真的很奇怪运行ge...
对我来说，尽管将其设置为“自动”，但并非所有公式都被计算出来，这是一个问题。我按了左下角的计算 100 次，然后神奇地起作用了。