Ошибка времени выполнения '1004': SaveAs Метод объекта '_Workbook failed

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 

Как указано в названии, операция SaveAs не работает. Я решил, что сбой - это результат того, что книга будет сохранена, потеряв фокус. Я могу выполнить код и получить ошибку. После генерирования ошибки выбор Debug в поле сообщения об ошибке, а затем нажатие F5 для запуска кода приведет к правильному сохранению книги. Размещение операторов Debug.Print до и после того, как метод Activate сохраненной книги будет сохранен, указывает, что активный wokbook - это книга, содержащая код и форму, используемую для обновления книги. Размещение инструкции печати в Immediate wondow, которая печатает ActiveWorkbook.Name приведет к печати имени рабочей книги для сохранения - 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 Как Workbook Dim wsActive как рабочий лист Dim sNWBName As String

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 

End Sub

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 

изменить одну вещь в то время, чтобы сделать его более, как ваш, и мы надеемся, что» все будет хорошо!

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