Question

我的VBA代码遇到了一些问题。我在Excel中创建了一个应用程序，其副本已分发给用户。为了能够纠正错误或添加一些新功能，每个副本都会存储信息的版本。我写了一个程序，它打开（只读）一个中央文件，即提供一些数据和信息，哪个版本是最新的。如果打开此中央文件的文件较旧，则会更新
所以auto_open调用一个过程发现它必须被更新，保存当前文件AS FileName_old.xlsm（有一些备份），杀死FileName.xlsm并从模板中复制一个新文件。问题是程序在尝试终止旧文件时崩溃（更确切地说，它只是在没有任何错误消息的情况下结束）。令我困惑的是，当我手动运行auto_open宏（F5）时，一切都正常。甚至一步一步走向正确。此外，当我通过工作表中的按钮调用更新过程时，它完美地工作。有什么想法，可能会导致这个问题吗？感谢

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

Answer 1

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

VBA在被auto_open

1 个答案: