Question

我正在开发代码以更新Excel中受保护的模块。

这是架构：

1：打开书籍时（Thisworkbook模块，打开功能），在书籍的工作簿版本和有效版本（连接到数据库）之间进行了比较。如果相同，则结束。如果不是，请转到步骤2。
2：调用UnprotectVBProj函数来取消保护VBA代码。
3：使用功能删除所有模块（除了包含取消保护，删除和加载新模块的功能的模块）。
4：使用称为“ import_modules”的功能从服务器重新加载模块。
5：新版本已在工作簿中设置，并且已关闭。

如果我逐步执行它，我的代码将起作用。

当打开书本自动运行时，函数“ DeleteVBAModulesAndUserForms”会返回一条错误消息，指出代码已受保护。如果我进行调试，则可以看到代码未受保护，实际上是不受保护的。就像没有将vbproject变量设置为新的不受保护状态一样。

代码如下：

Sub Workbook_Open()

Application.DisplayAlerts = False
Application.ScreenUpdating = False

'Variables
Dim herramienta As String
Dim password_hoja As String
Dim password_visual As String

password_visual = "1111111111"
herramienta = "222222222"
password_hoja = "333333333"

Dim miversion As String
Dim WS_Count as Integer, i As Integer

miversion = CStr(Sheets("Control").Range("AG106").Value)

'Here is the function to make the comparation with version stered in database
If ultima_version(herramienta) = miversion Then

Else`enter code here`
    MsgBox ("Old version, need to update.")
    'Unprotect the code
    Call UnprotectVBProj(ThisWorkbook, password_visual)
    'delete all modules
    Call DeleteVBAModulesAndUserForms
    'load new modules
    Call importa_modulos
    'change version in sheet
    ActiveSheet.Unprotect Password:=password_hoja
    Sheets("Control").Range("AG106").Value = ultima_version(herramienta)
    ActiveSheet.Protect Password:=password_hoja, DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowSorting:= _
        True, AllowFiltering:=True, AllowUsingPivotTables:=True
    'Save and close
    ActiveWorkbook.Close (1)
End If

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

Sub UnprotectVBProj(ByRef WB As Workbook, ByVal Password As String)
  Dim vbProj As Object
  Set vbProj = WB.VBProject

  Application.ScreenUpdating = True

  If vbProj.Protection <> 1 Then Exit Sub
  Set Application.VBE.ActiveVBProject = vbProj

  SendKeys Password & "~"
  SendKeys "~"
  Application.VBE.CommandBars(1).FindControl(ID:=2578, recursive:=True).Execute

  Application.ScreenUpdating = False
End Sub

Sub DeleteVBAModulesAndUserForms()

        Dim vbProj2 As Object
        Dim VBComp As Object

        Set vbProj2 = ActiveWorkbook.VBProject

        'Next line is commented to display protection error
        'If vbProj2.Protection <> vbext_pp_none Then Exit Sub

        For Each VBComp In vbProj2.VBComponents
            Select Case VBComp.Type
            Case Is = vbext_ct_StdModule, vbext_ct_ClassModule, vbext_ct_MSForm
                If VBComp.Name = "A_Importa_Modulos" Or VBComp.Name = "ThisWorkbook" Then
                    'Thisworkbook or worksheet module
                    'We do nothing
                Else
                    vbProj2.VBComponents.Remove VBComp
                End If
            Case Is = vbext_ct_Document
                'With VBComp.CodeModule
                '.DeleteLines 1, .CountOfLines
                'End With
            End Select
        Next VBComp
End Sub

VBComponents变量未更新

0 个答案: