从VB代码取消保护VBProject

时间：2013-04-23 16:24:23

标签： excel vba excel-vba excel-2007

如何从vb宏取消保护我的VB项目？ 我找到了这段代码：

    Sub UnprotectVBProject(ByRef WB As Workbook, ByVal Password As String)
  Dim VBProj As Object
  Set VBProj = WB.VBProject
  Application.ScreenUpdating = False
  'Ne peut procéder si le projet est non-protégé.
  If VBProj.Protection <> 1 Then Exit Sub
  Set Application.VBE.ActiveVBProject = VBProj
  'Utilisation de "SendKeys" Pour envoyer le mot de passe.

  SendKeys Password & "~"
  SendKeys "~"
  'MsgBox "Après Mot de passe"
  Application.VBE.CommandBars(1).FindControl(ID:=2578, recursive:=True).Execute
  Application.Wait (Now + TimeValue("0:00:1"))

End Sub

但是这个解决方案不适用于Excel 2007.它在我的IDE中显示验证的窗口和打印密码。

然后，我的目标是在不显示此窗口的情况下取消保护我的VBproject。

感谢您的帮助。

3 个答案:

答案 0 :(得分：41)

修改：

将此转换为VBA和VB.Net的BLOG post。

我从未赞成Sendkeys。它们在某些情况下是可靠的但并非总是如此。虽然我有一个软角落的API。

您可以实现所需的功能，但必须确保必须在单独的Excel实例中打开要取消保护VBA的工作簿。

这是一个例子

假设我们当前有一个VBA项目看起来像这样的工作簿。

enter image description here

<强> LOGIC ：

  1. 使用FindWindow

    2. 查找“VBAProject密码”窗口的句柄

  2. 找到后，使用FindWindowEx

    3. 在该窗口中找到编辑框的句柄

  3. 找到编辑框的句柄后，只需使用SendMessage即可写入。

  4. 使用Buttons

    5. 在该窗口中找到FindWindowEx的句柄

  5. 找到OK按钮的句柄后，只需使用SendMessage进行点击即可。

    6. 推荐：

    1. 对于API，THIS是我可以推荐的最佳链接。

    2. 如果您希望擅长API FindWindow，FindWindowEx和SendMessage，那么请获取一个工具，为您提供系统进程，线程，窗口的图形视图和窗口消息。对于Ex：uuSpy或Spy ++。

      3. 以下是Spy ++将为您显示的“VBAProject密码”窗口

      enter image description here

      <强>测试：

      打开一个新的Excel实例并将以下代码粘贴到模块中。

      代码:(已经过测试和测试）

      我已经对代码进行了评论，因此您不应该对它有任何问题。

      Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
(ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, _
ByVal lpsz2 As String) As Long

Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
(ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long

Private Declare Function GetWindowTextLength Lib "user32" Alias _
"GetWindowTextLengthA" (ByVal hwnd As Long) As Long

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Dim Ret As Long, ChildRet As Long, OpenRet As Long
Dim strBuff As String, ButCap As String
Dim MyPassword As String

Const WM_SETTEXT = &HC
Const BM_CLICK = &HF5

Sub UnlockVBA()
    Dim xlAp As Object, oWb As Object

    Set xlAp = CreateObject("Excel.Application")

    xlAp.Visible = True

    '~~> Open the workbook in a separate instance
    Set oWb = xlAp.Workbooks.Open("C:\Sample.xlsm")

    '~~> Launch the VBA Project Password window
    '~~> I am assuming that it is protected. If not then
    '~~> put a check here.
    xlAp.VBE.CommandBars(1).FindControl(ID:=2578, recursive:=True).Execute

    '~~> Your passwword to open then VBA Project
    MyPassword = "Blah Blah"

    '~~> Get the handle of the "VBAProject Password" Window
    Ret = FindWindow(vbNullString, "VBAProject Password")

    If Ret <> 0 Then
        'MsgBox "VBAProject Password Window Found"

        '~~> Get the handle of the TextBox Window where we need to type the password
        ChildRet = FindWindowEx(Ret, ByVal 0&, "Edit", vbNullString)

        If ChildRet <> 0 Then
            'MsgBox "TextBox's Window Found"
            '~~> This is where we send the password to the Text Window
            SendMess MyPassword, ChildRet

            DoEvents

            '~~> Get the handle of the Button's "Window"
            ChildRet = FindWindowEx(Ret, ByVal 0&, "Button", vbNullString)

            '~~> Check if we found it or not
            If ChildRet <> 0 Then
                'MsgBox "Button's Window Found"

                '~~> Get the caption of the child window
                strBuff = String(GetWindowTextLength(ChildRet) + 1, Chr$(0))
                GetWindowText ChildRet, strBuff, Len(strBuff)
                ButCap = strBuff

                '~~> Loop through all child windows
                Do While ChildRet <> 0
                    '~~> Check if the caption has the word "OK"
                    If InStr(1, ButCap, "OK") Then
                        '~~> If this is the button we are looking for then exit
                        OpenRet = ChildRet
                        Exit Do
                    End If

                    '~~> Get the handle of the next child window
                    ChildRet = FindWindowEx(Ret, ChildRet, "Button", vbNullString)
                    '~~> Get the caption of the child window
                    strBuff = String(GetWindowTextLength(ChildRet) + 1, Chr$(0))
                    GetWindowText ChildRet, strBuff, Len(strBuff)
                    ButCap = strBuff
                Loop

                '~~> Check if we found it or not
                If OpenRet <> 0 Then
                    '~~> Click the OK Button
                    SendMessage ChildRet, BM_CLICK, 0, vbNullString
                Else
                    MsgBox "The Handle of OK Button was not found"
                End If
            Else
                 MsgBox "Button's Window Not Found"
            End If
        Else
            MsgBox "The Edit Box was not found"
        End If
    Else
        MsgBox "VBAProject Password Window was not Found"
    End If
End Sub

Sub SendMess(Message As String, hwnd As Long)
    Call SendMessage(hwnd, WM_SETTEXT, False, ByVal Message)
End Sub

答案 1 :(得分：7)

我知道你已经锁定了这个以获得新的答案，但我在上面的代码中遇到了一些问题，主要是因为我在Office 64位（VBA7）中工作。但是我也这样做了，所以代码可以在Excel的当前实例中工作，并添加了一些错误检查并将其格式化为粘贴到一个单独的模块中，只显示方法var dateStart = moment('2013-8-31'); var dateEnd = moment('2015-3-30'); var timeValues = []; while (dateEnd > dateStart || dateStart.format('M') === dateEnd.format('M')) { timeValues.push(dateStart.format('YYYY-MM')); dateStart.add(1,'month'); } 。

对于完全披露，我真的开始使用this post中的代码，尽管它是主题的变体。

代码还显示了条件编译常量，因此它应该同时兼容32位和64位版本的Excel。我使用this page来帮助我解决这个问题。

无论如何这里是代码。希望有人发现它有用：

UnlockProject

答案 2 :(得分：0)

@James Macadie的答案（以上）是我发现的最好的答案（我正在运行32位Excel 365/2019）

注意：我发现您必须具有Application.ScreenUpdating = True才能通过其他子或函数调用James的方法。否则，您可能会遇到Invalid procedure call or argument错误（如果在调试模式之外运行）。

此解决方案似乎优于以下两个方面：

  1. http://www.siddharthrout.com/index.php/2019/01/20/unprotect-vbproject-from-vb-code/。创建一个单独的Excel Application实例来运行解锁过程，该过程不适用于我的用例

  2. https://www.mrexcel.com/board/threads/lock-unlock-vbaprojects-programmatically-without-sendkeys.1136415/。不稳定，并且如果为多个工作簿顺序运行会失败，我认为由于缺少James解决方案中实现的计时器/等待循环-我没有彻底调试问题

相关问题
最新问题