Unprotect VBProject from VB code

Question

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 

But this solution doesn't work for Excel 2007. It display the authentification's window and print password in my IDE.

Then, my goal is to unprotect my VBproject without displaying this window.

Thanks for any help.

Answer 1

EDIT:

Converted this to a BLOG post for VBA and VB.Net.

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.

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.

Here is an example

Let's say we have a workbook who's VBA project looks like this currently.

LOGIC:

1. Find the Handle of the "VBAProject Password" window using FindWindow

2. Once that is found, find the handle of the Edit Box in that window using FindWindowEx

3. Once the handle of the Edit Box is found, simply use SendMessage to write to it.

4. Find the handle of the Buttons in that window using FindWindowEx

5. Once the handle of the OK button is found, simply use SendMessage to click it.

RECOMMENDATION:

1. For API's THIS is the best link I can recommend.

2. 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++.

Here is what Spy++ will show you for "VBAProject Password" window

TESTING:

Open a new Excel instance and paste the below code in a module.

CODE:

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