首页 文章

运行时错误'1004'：SaveAs对象'_Workbook的方法失败

提问于
浏览 次
0

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

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

如 Headers 中所述，SaveAs操作失败 . 我已经确定失败是因为保存了工作簿而失去了焦点 . 我可以单步执行代码并获取错误 . 生成错误后，在错误消息框中选择“调试”，然后按F5运行代码将导致正确保存工作簿 . 在要保存的worbook的Activate方法之前和之后放置Debug.Print语句表示活动的wokbook是包含代码和用于更新工作簿的表单的工作簿 . 在打印ActiveWorkbook.Name的Immediate wondow中放置一个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方法时，要保存的工作簿必须是活动工作簿 .

Private Sub cmdSaveUpdatedWB_Click（）On Error GoTo Err_cmdSaveUpdatedWB_Click

Dim wbSave As Workbook Dim wsActive As Worksheet Dim sNWBName As String

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

Exit_cmdSaveUpdatedWB_Click：

Set wbSave = Nothing
Exit Sub

Err_cmdSaveUpdatedWB_Click：Dim strErrMsg As String

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

结束子

excel vba

1 回答

  • 0

    你为什么不从这样的事情开始

    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

    一次改变一件事，使它更像你的，希望它一切正常！

    Update

    根据评论 . 如果您尝试打开，更新并关闭数百个工作簿 . 您可以将此作为指南：

    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
    回复于

相关问题