运行时错误"1004"：对象"_Workbook的另存为方法失败

Question

我正在使用以下代码保存更新的工作簿。

Private Sub cmdSaveUpdatedWB_Click()
On Error GoTo Err_cmdSaveUpdatedWB_Click
gwbTarget.Activate   <<<<<<<<<<<<<<<<<<<<<<<
Application.DisplayAlerts = False
gwbTarget.SaveAs txtUpdWorkbookName.Value, FileFormat:=xlOpenXMLWorkbookMacroEnabled
Application.DisplayAlerts = False
frmLoanWBMain.Show
gwbTarget.Close
Set gwbTarget = Nothing
gWBPath = ""
gWBName = ""
lblWorkbookSaved.Enabled = True
cmdUpdateAnotherWorkbook.Visible = True
Exit_cmdSaveUpdatedWB_Click:
Exit Sub
Err_cmdSaveUpdatedWB_Click:
MsgBox "The following error occurred inthe [cmdSaveUpdateWB_Click] event handler." & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & "Error descriptioin: " & Err.Description
Resume Exit_cmdSaveUpdatedWB_Click
End Sub

如标题中所述，"另存为"操作失败。我已经确定失败是由于要保存的工作簿失去了焦点。我可以遍历代码并得到错误。生成错误后，在错误消息框中选择"调试"，然后按F5键运行代码，将正确保存工作簿。在要保存的工作簿的Activate方法之前和之后放置Debug.Print语句表示活动工作簿是包含用于更新工作簿的代码和表单的工作簿。在打印ActiveWorkbook.Name的即时窗口中放置print语句将导致打印要保存的工作簿的名称-gwbTarget.Name。然后按F5键正确运行代码。我一直无法弄清楚要保存的工作簿失去焦点的原因。我放置了延迟、多个激活语句、用于保存工作簿和用于保存工作簿名称的本地变量。任何关于为什么会发生这种情况以及如何解决的帮助或想法都将不胜感激。

我确实做了一些改变。下面列出了代码。。。

Private Sub cmdSaveUpdatedWB_Click()
On Error GoTo Err_cmdSaveUpdatedWB_Click
Dim wbSave As Workbook
Set wbSave = gwbTarget
gwbTarget.Activate
Application.DisplayAlerts = False
'''''''    gwbTarget.SaveAs txtUpdWorkbookName.Value, FileFormat:=xlOpenXMLWorkbookMacroEnabled
wbSave.SaveAs fileName:=txtUpdWorkbookName.Value, FileFormat:=xlOpenXMLWorkbookMacroEnabled
Application.DisplayAlerts = False
frmLoanWBMain.Show
gwbTarget.Close
Set gwbTarget = Nothing
gWBPath = ""
gWBName = ""
lblWorkbookSaved.Enabled = True
cmdUpdateAnotherWorkbook.Visible = True

Exit_cmdSaveUpdatedWB_Click:
Set wbSave = Nothing
Exit Sub
Err_cmdSaveUpdatedWB_Click:
MsgBox "The following error occurred inthe [cmdSaveUpdateWB_Click] event handler." & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & "Error descriptioin: " & Err.Description
Resume Exit_cmdSaveUpdatedWB_Click
End Sub

我已经更改了代码，使其更接近下面的建议。下面列出了进入程序时的变量定义。Excel代码在Citrix环境中运行，这可能会影响计时，但不应该对代码执行产生任何其他影响。

为了简洁起见，我删除了其他代码版本。以下代码起作用。关键问题是，调用SaveAs方法时，要保存的工作簿必须是活动工作簿。

私有子cmdSaveUpdatedWB_Click()出错时转到Err_cmdSaveUpdatedWB_Click

Dim wb另存为工作簿Dim wsActive As WorksheetDim sNWB名称为字符串

Application.DisplayAlerts = False
sNWBName = txtUpdWorkbookName.Value
Set wbSave = gwbTarget
wbSave.Activate
Set wsActive = wbSave.ActiveSheet
wbSave.SaveAs fileName:=sNWBName, FileFormat:=xlOpenXMLWorkbookMacroEnabled
Application.DisplayAlerts = True
frmLoanWBMain.Show
gwbTarget.Close
Set gwbTarget = Nothing
gWBPath = ""
gWBName = ""
lblWorkbookSaved.Enabled = True
cmdUpdateAnotherWorkbook.Visible = True

退出cmdSaveUpdatedWB_Click:

Set wbSave = Nothing
Exit Sub

错误cmdSaveUpdatedWB_Click：Dim strErrMsg为字符串

strErrMsg = "Error Number: " & Err.Number & " Desc: " & Err.Description & vbCrLf & _
"Source:" & Err.Source & vbCrLf & _
"Updating Workbook: " & vbCrLf & "      " & gwbTarget.Name & vbCrLf & _
"Selected Worksheet: " & gwsTrgSheet.Name & vbCrLf & _
"Active Workbook: " & vbCrLf & "      " & ActiveWorkbook.Name & vbCrLf & _
"Worksheet: " & ActiveSheet.Name & vbCrLf & _
"Code Segment: cmdSaveUpdatedWB_Click event handler"
RecordErrorInfo strErrMsg
Resume Exit_cmdSaveUpdatedWB_Click

结束子

Answer 1

为什么不从这个开始呢

Private Sub cmdSaveUpdatedWB_Click()
Dim gwbTarget As Workbook
Set gwbTarget = Workbooks("workbook_name.xlsm") 'correct extension needed, workbook must be open
wb.SaveAs Filename:=gwbTarget.Path, FileFormat:=xlOpenXMLWorkbookMacroEnabled
MsgBox "Last saved: " & gwbTarget.BuiltinDocumentProperties("Last Save Time")
End Sub

一次改变一件事，让它更像你的，希望一切都会好起来！

更新

根据评论。如果您正在尝试打开、更新和关闭数百个工作簿。你可以用这个作为指南：

Sub ChangeWorkbooks()
Application.ScreenUpdating = False
Dim wbPaths As Range, wbSaveFilenames As Range
With Sheet1 'you will need to update this and the ranges below
Set wbPaths = .Range("A1:A650") 'including file extensions
Set wbSaveFilenames = .Range("B1:B650") 'including file extensions
End With
Dim i As Integer, totalBooks As Integer
Dim wbTemp As Workbook
totalBooks = wbPaths.Rows.Count
For i = 1 To totalBooks
Application.StatusBar = "Updating workbook " & i & " of " & totalBooks 'display statusbar message to user
Set wbTemp = Workbooks.Open(wbPaths.Cells(i, 1), False)
'make changes to wbTemp here
wbTemp.SaveAs wbSaveFilenames.Cells(i, 1)
wbTemp.Close
Next i
Set wbTemp = Nothing
Application.ScreenUpdating = True
Applicaton.StatusBar = False
End Sub