vba - 取消对 VBProject 的 VB 代码保护

Question

如何取消对 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 中显示身份验证窗口并打印密码。

然后，我的目标是取消保护我的 VB 项目而不显示此窗口。

感谢您的帮助。

Answer 1

编辑:

将其转换为 BLOG post适用于 VBA 和 VB.Net。

我从来不赞成Sendkeys。它们在某些情况下是可靠的，但并非总是可靠。不过我对 API 有一个软肋。

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

这是一个例子

假设我们有一个工作簿，其 VBA 项目当前如下所示。

逻辑:

1. 使用FindWindow查找“VBAProject密码”窗口的句柄

2. 找到后，使用 FindWindowEx 查找该窗口中编辑框的句柄

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

4. 使用FindWindowEx查找该窗口中Buttons的句柄

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

建议:

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

2. 如果您希望精通 FindWindow、FindWindowEx 和 SendMessage 等 API，那么请获取一个为您提供图形化界面的工具系统进程、线程、窗口和窗口消息的 View 。例如:uuSpy 或 Spy++。

这是 Spy++ 将向您显示的“VBAProject 密码”窗口

测试:

打开一个新的 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