从VB代码取消保护VBProject [英] Unprotect VBProject from VB code
问题描述
如何从vb宏中取消对VB项目的保护？
i已找到此代码：
How can i unprotect my VB project from a vb macro ? i have found this code:
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中显示验证窗口并打印密码。
But this solution doesn't work for Excel 2007. It display the authentification's window and print password in my IDE.
然后，我的目标是在不显示此窗口的情况下取消保护我的VBProject。
Then, my goal is to unprotect my VBproject without displaying this window.
感谢任何帮助。
推荐答案
编辑：
这是一个 BLOG发布 VBA和VB.Net。
Converted this to a BLOG post for VBA and VB.Net.
我从来没有赞成 Sendkeys 。他们在某些情况下是可靠的，但并不总是。我有一个软的角落API，虽然。
I have never been in favor of Sendkeys. They are reliable in some case but not always. I have a soft corner for API's though.
可以实现你想要的，但是你必须确保你要取消保护VBA的工作簿必须在单独的Excel实例中打开。
What you want can be achieved, however you have to ensure that workbook for which you want to un-protect the VBA has to be opened in a separate Excel Instance.
这是一个例子
假设我们有一个工作簿是VBA项目看起来像这样。
Let's say we have a workbook who's VBA project looks like this currently.
LOGIC ：
-
查找 VBAProject Password窗口使用
FindWindow
一旦找到，找到编辑框的句柄该窗口使用 FindWindowEx
Once that is found, find the handle of the Edit Box in that window using FindWindowEx
一旦找到编辑框的句柄，只需使用 SendMessage 写入。
Once the handle of the Edit Box is found, simply use SendMessage to write to it.
查找按钮的句柄在该窗口中使用 FindWindowEx
一旦确定按钮，只需使用 SendMessage 单击它。
Once the handle of the OK button is found, simply use SendMessage to click it.
推荐：
-
对于API的这是我可以推荐的最好的链接。
For API's THIS is the best link I can recommend.
如果你想beco我喜欢API，像 FindWindow ， FindWindowEx 和 SendMessage 然后获得一个工具，为您提供系统进程，线程，窗口和窗口消息的图形视图。对于Ex：uuSpy或Spy ++。
If you wish to become good at API's like FindWindow, FindWindowEx and SendMessage then get a tool that gives you a graphical view of the system’s processes, threads, windows, and window messages. For Ex: uuSpy or Spy++.
这是Spy ++将为您显示VBAProject Password窗口
Here is what Spy++ will show you for "VBAProject Password" window
测试：
打开一个新的Excel实例，并将以下代码粘贴到模块中。
Open a new Excel instance and paste the below code in a module.
代码：（TRIED AND TESTED）
我已经评论过代码，所以你不应该任何问题了解。
I have commented the code so you shouldn't have any problem understanding it.
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
这篇关于从VB代码取消保护VBProject的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
