2016-06-23 2 views
0


У меня возникли проблемы с кодом VBA. Я создал приложение в Excel, и его копии были распространены среди пользователей. Чтобы иметь возможность исправлять ошибки или добавлять новые функции, каждая копия хранит информацию о том, какая версия. Я написал процедуру, которая открывает (только для чтения) центральный файл, который предоставляет некоторые данные a и информацию, какая версия является текущей. Если файл, который открыл этот центральный файл, старше, он обновляется.

Таким образом, auto_open вызывает процедуру, обнаружив, что она должна быть обновлена, сохраняет текущий файл AS FileName_old.xlsm (чтобы иметь некоторую резервную копию), убивает FileName.xlsm и копирует новый файл из шаблона. Проблема заключается в том, что при сбое программы при попытке убить старый файл (точнее, он заканчивается без сообщения об ошибке). Меня смущает то, что когда я запускаю макрос auto_open вручную (F5), все идет правильно. Даже шаг за шагом идет правильно. Кроме того, когда я вызываю процесс обновления с помощью кнопки на листе, он работает отлично. Любая идея, что может вызвать эту проблему?
БлагодаряVBA убивает аварии после вызова auto_open

Sub auto_open() 
    If Range("H_User").Value = "" Then UserNameWindows 'Write a user that is using this workbook in the range H_User 

    If Range("H_Updated").Value < FileDateTime(Range("H_File_Data").Value) Then UpdateData 
End Sub 


Sub UpdateData() 
    Dim ActWB As String 
    ActWB = ActiveWorkbook.Name 
    Application.ScreenUpdating = False 
    ThisWorkbook.Activate 

    If Not FileExists(Range("H_File_Data").Value) Then 
     MsgBox "The data file is not available!", vbCritical 
     Workbooks(ActWB).Activate 
     Application.ScreenUpdating = True 
     Exit Sub 
    End If 

    Dim WB As String, oknoData As String, IsTeam As Boolean, User As String 
    Dim version As Integer, Subversion As Integer, DataPath As String 

    On Error GoTo konec 

    Application.EnableCancelKey = xlDisabled 
    IsTeam = False 
    User = Range("H_User").Value 
    WB = ActiveWindow.Caption 
    version = Range("H_version").Value 
    Subversion = Range("H_Subversion").Value 
    Range("C_Data_All").ClearContents 
    DataPath = Range("H_File_Data").Value 
    Workbooks.Open fileName:=DataPath, ReadOnly:=True 
    oknoData = ActiveWindow.Caption 

    If Range("H_version_Spec").Value <= version Or (Range("H_version_Spec").Value = version And Range("H_Subversion_Spec").Value <= Subversion) Then 
     FileUpdate 
    End If 

    'If there is no need to update the file then continue with in this procedure 
End Sub 

Sub FileUpdate() 
    Dim NewPath As String, NewWB As String, OldPath As String, OldWB As String, BackupWB As String, BackupPath As String 
    Dim MainWB As String, version As String, Subversion As String 
    Dim versionMax As Integer, SubversionMax As Integer, versionMin As Integer, SubversionMin As Integer 

    ThisWorkbook.Activate 
    version = Range("H_version").Value 
    Subversion = Range("H_Subversion").Value 

    OldPath = ThisWorkbook.FullName 
    OldWB = ThisWorkbook.Name 
    BackupWB = Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 5) & "_old.xlsm" 
    BackupPath = ThisWorkbook.Path & "\" & BackupWB 

    If Not FileExists(Workbooks(OldWB).Names("H_File_Data").RefersToRange.Value) Then 
     MsgBox "The data file is not available!", vbCritical 
     Exit Sub 
    End If 


    Workbooks.Open fileName:=Workbooks(OldWB).Names("H_File_Data").RefersToRange.Value, ReadOnly:=True 
    MainWB = ActiveWorkbook.Name 

    If version = Range("O_Spec_version").Value And Subversion >= Range("O_Spec_Subversion").Value Then 
     'Just some little piece of code if the version is not lower 
    Else 
     If FileExists(BackupPath) Then Kill (BackupPath) 
    If Not FileExists(Range("H_Path_Spec_Actual").Value) Then 
     MsgBox "The spec template is not available!", vbCritical 
     Exit Sub 
    End If 
    ThisWorkbook.SaveAs BackupPath 
    Kill (OldPath) 

    'Continue with update 
    End If 
End Sub 

Function FileExists(FilePath As String) As Boolean 
    Dim fso As Object 
    Set fso = CreateObject("scripting.filesystemobject") 

    FileExists= fso.FileExists(FilePath) 
End Function 
+1

Пожалуйста, покажите код у вас возникли проблемы с; это значительно упрощает попытку помочь вам исправить это ... – Dave

+0

Добавлена ​​определенная часть. Проблема с Kill (OldPath) вызывает проблему. Но опять же, только когда auto_open запускается сам по себе, а не когда я запускаю его вручную – markor

+3

Итак, вы убиваете рабочий лист, на котором работает код ... и удивлены, когда код перестает выполняться? – Dave

ответ

0
Option Explicit 

Private Sub Workbook_Open() 
    Dim BackupPath As String 
    Dim OldPath As String 

    BackupPath = "folder\Filename_old.xlsm" 

    With ThisWorkbook 
     OldPath = .FullName 
     .SaveCopyAs BackupPath 
     .Saved = True 
     .ChangeFileAccess xlReadOnly 
     Kill .FullName 
     .Close False 
    End With 
End Sub 
+0

Спасибо за ваше предложение, но проблема с вашим кодом заключается в том, что он убивает книгу, которая запускает код, но после этого мне нужен код, чтобы сделать некоторые другие вещи. – markor

+0

Не могли бы вы делать что-то еще, убивая книгу? Это было бы идеальным. –

Смежные вопросы