Option Explicit

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, PropRet As Long
Dim strBuff As String, ButCap As String

Const WM_SETTEXT = &HC
Const BM_CLICK = &HF5

Const MyPassword As String = "test"
Const MyProjName As String = "VBAProject"
Const MyWbPath As String = "G:\Test\Test.xlsm"
Const MyModule As String = "Module1"

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(MyWbPath)

    '~~> Launch the VBA Project Password window
    '~~> I am assuming that it is protected. If not then
    '~~> put a check here.
    xlAp.VBE.MainWindow.SetFocus
    xlAp.VBE.CommandBars(1).FindControl(ID:=2578, recursive:=True).Execute
    '~~> Get the handle of the "VBAProject Password" Window
    xlAp.VBE.MainWindow.SetFocus
    Ret = FindWindow(vbNullString, MyProjName & " Password")

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

        '~~> Get the handle of the TextBox Window where we need to type the password
        xlAp.VBE.MainWindow.SetFocus
        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"
            xlAp.VBE.MainWindow.SetFocus
            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
                    xlAp.VBE.MainWindow.SetFocus
                    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
                    
                    '~~> Get the handle of the "VBAProject - Project Properties" Window
                    xlAp.VBE.MainWindow.SetFocus
                    PropRet = FindWindow(vbNullString, MyProjName & " - Project Properties")
                    If PropRet <> 0 Then
                        '~~> Get the handle of the Button's "Window"
                        xlAp.VBE.MainWindow.SetFocus
                        ChildRet = FindWindowEx(PropRet, 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
                                xlAp.VBE.MainWindow.SetFocus
                                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 Handle of Properties window was not found"
                    End If
                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
    
    'Delete module
    DeleteModule oWb, MyModule
    
    'Clese workbook
    oWb.Close SaveChanges:=True
    
    'Close application
    xlAp.Quit
End Sub

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

Sub DeleteModule(wb As Workbook, strVBMod As String)
        Dim VBProj As VBIDE.VBProject
        Dim VBComp As VBIDE.VBComponent
    
        Set VBProj = wb.VBProject
        Set VBComp = VBProj.VBComponents(strVBMod)
        VBProj.VBComponents.Remove VBComp
End Sub

Option Explicit

'***************************************************************************************
'Author: KL(XL) 16-Feb-2016
'Based on the code published by Siddharth Rout in the below link
'http://www.siddharthrout.com/2013/04/24/unprotecting-vba-project-password-using-a-password-that-you-know/
'Requirements:
'Access to VBA Project Object Model must be trusted for this code to work
'You need to know the project password to be able to unprotect it by this code
'***************************************************************************************
'Win API declarations x86 x64
'***************************************************************************************
#If VBA7 Then
    Private Declare PtrSafe Function FindWindow Lib "user32" _
            Alias "FindWindowA" ( _
            ByVal lpClassName As String, _
            ByVal lpWindowName As String) As LongPtr
            
    Private Declare PtrSafe Function FindWindowEx Lib "user32" _
            Alias "FindWindowExA" ( _
            ByVal hWnd1 As LongPtr, _
            ByVal hWnd2 As LongPtr, _
            ByVal lpsz1 As String, _
            ByVal lpsz2 As String) As LongPtr
    
    Private Declare PtrSafe Function GetWindowText Lib "user32" _
            Alias "GetWindowTextA" ( _
            ByVal hwnd As LongPtr, _
            ByVal lpString As String, _
            ByVal cch As Long) As Long
    
    Private Declare PtrSafe Function GetWindowTextLength Lib "user32" _
            Alias "GetWindowTextLengthA" ( _
            ByVal hwnd As LongPtr) As Long
            
    Declare PtrSafe Function SendMessage Lib "user32" _
            Alias "SendMessageA" ( _
            ByVal hwnd As LongPtr, _
            ByVal wMsg As Long, _
            ByVal wParam As LongPtr, _
            lParam As Any) As LongPtr
            
    Dim Ret As LongPtr, ChildRet As LongPtr, OpenRet As LongPtr, PropRet As LongPtr
#Else
    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, PropRet As Long
#End If

Dim strBuff As String, ButCap As String

Const WM_SETTEXT = &HC
Const BM_CLICK = &HF5
'***************************************************************************************

Sub ManipulateProtectedVBAProject()
    Dim xlAp As Object, oWb As Object
    Dim VBComp As VBIDE.VBComponent
    Dim MyProjName As String
    Dim MyPassword As String
    Dim MyWbPath As String
    Dim MyModule As String
    Dim blnModuleDeleted As Boolean
    Dim UserResponse As VbMsgBoxResult
    Dim fd As FileDialog
    Dim i As Long, x As Long
    Dim strIniFolder As String
    
    'Provide name of module to delete
    MyModule = "Module1"
    'Provide password
    MyPassword = "test"
    'Get file path
    
    'Create log file
    x = FreeFile
    Open ThisWorkbook.Path & "\Log.txt" For Output As #x
    
    'Get files list via user dialog
    strIniFolder = ThisWorkbook.Path & "\"
    Set fd = Application.FileDialog(msoFileDialogOpen)
    With fd
        .Title = "Open Macro-Enabled Excel Files"
        .ButtonName = "Open"
        'Remove previous filters
        .Filters.Clear
        'Set file filters
        .Filters.Add _
                Description:="Microsoft Excel Files", _
                Extensions:="*.xlsm", _
                Position:=1
        .AllowMultiSelect = True
        'Starting folder
        .InitialFileName = strIniFolder
        .Show
        'Check if files selected
        If .SelectedItems.Count > 0 Then
            'Create a new instance of Excel application (guest)
            Set xlAp = CreateObject("Excel.Application")
            
            'Loop through selected files
            For i = 1 To .SelectedItems.Count
                
                'Open the workbook in guest application
                Set oWb = xlAp.Workbooks.Open(.SelectedItems.Item(i))
                'Get workbook's VBA Project Name
                MyProjName = oWb.VBProject.Name
                '***************************************************
                'Unprotection part
                '***************************************************
                'Check if VBA Project is protected
                If oWb.VBProject.Protection = vbext_pp_locked Then
                    'Make the application visible
                    xlAp.Visible = True
                    'Unlock VBA Project
                    UnlockVBA xlAp, MyProjName, MyPassword
                    'Update log
                    Print #x, Now(), oWb.Name, "Project [" & MyProjName & "] was temporarily unprotected"
                Else
                    'Update log
                    Print #x, Now(), oWb.Name, "Project [" & MyProjName & "] was not protected"
                End If
                '***************************************************
                'Main routine
                '***************************************************
                'Check if module exists
                On Error Resume Next
                Set VBComp = oWb.VBProject.VBComponents(MyModule)
                'If the module doesn't exist
                If Err <> 0 Then
                    'Update log
                    Print #x, Now(), oWb.Name, "Module [" & MyModule & "] not found"
                    'Do nothing, close workbook without saving
                    oWb.Close SaveChanges:=False
                'If the module exists
                Else
                    'Do the intended action. Delete module saving changes
                    oWb.VBProject.VBComponents.Remove VBComp
                    'Update log
                    Print #x, Now(), oWb.Name, "Module [" & MyModule & "] successfully deleted"
                    oWb.Close SaveChanges:=True
                End If
                On Error GoTo 0
                '***************************************************
            Next i
            'Close guest application
            xlAp.Quit
        Else
            'Update log
            Print #x, Now(), "Operation cancelled by the user: No files selected."
            'Feedback and exit if nothing selected
            MsgBox "No files selected"
        End If
    End With
    'Close log file
    Close #x
End Sub

Private Sub UnlockVBA(xlAp As Object, MyProjName As String, MyPassword As String)
    'KL: Activate remote VBE window to prevent losing control
    xlAp.VBE.MainWindow.SetFocus
    'Launch "VBA Project Password" window by clicking on VBA Project Properties button
    xlAp.VBE.CommandBars(1).FindControl(ID:=2578, recursive:=True).Execute
    'KL: Activate remote VBE window to prevent losing control
    xlAp.VBE.MainWindow.SetFocus
    'Get handle of "VBAProject Password" window
    Ret = FindWindow(vbNullString, MyProjName & " Password")

    'Check if we found it or not
    If Ret <> 0 Then
        'KL: Activate remote VBE window to prevent losing control
        xlAp.VBE.MainWindow.SetFocus
        'Get handle of TextBox window where we need to type password
        ChildRet = FindWindowEx(Ret, ByVal 0&, "Edit", vbNullString)
        'Check if we found Password Textbox
        If ChildRet <> 0 Then
            'Send password to TextBox
            SendMess MyPassword, ChildRet
            DoEvents
            'KL: Activate remote VBE window to prevent losing control
            xlAp.VBE.MainWindow.SetFocus
            'Get handle of Buttons window of "VBAProject Password" window
            ChildRet = FindWindowEx(Ret, ByVal 0&, "Button", vbNullString)
            'Check if we found Buttons window of "VBAProject Password" window
            If ChildRet <> 0 Then
                'Get caption of 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 caption has word "OK"
                    If InStr(1, ButCap, "OK") Then
                        'If this is button we are looking for then exit
                        OpenRet = ChildRet
                        Exit Do
                    End If
                    'KL: Activate remote VBE window to prevent losing control
                    xlAp.VBE.MainWindow.SetFocus
                    'Get handle of next child window
                    ChildRet = FindWindowEx(Ret, ChildRet, "Button", vbNullString)
                    'Get caption of child window
                    strBuff = String(GetWindowTextLength(ChildRet) + 1, Chr$(0))
                    GetWindowText ChildRet, strBuff, Len(strBuff)
                    ButCap = strBuff
                Loop
                'Check if we found OK button of "VBAProject Password" window
                If OpenRet <> 0 Then
                    'Click OK Button. "VBAProject - Project Properties" window will open
                    SendMessage ChildRet, BM_CLICK, 0, vbNullString
                    'KL: Activate remote VBE window to prevent losing control
                    xlAp.VBE.MainWindow.SetFocus
    '***************************************************************************************
    'KL: Added this code to close "VBAProject - Project Properties" window
    '***************************************************************************************
                    'Get handle of "VBAProject - Project Properties" window
                    PropRet = FindWindow(vbNullString, MyProjName & " - Project Properties")
                    'Check if we found "VBAProject - Project Properties" window
                    If PropRet <> 0 Then
                        'KL: Activate remote VBE window to prevent losing control
                        xlAp.VBE.MainWindow.SetFocus
                        'Get handle of Buttons window of "VBAProject - Project Properties" window
                        ChildRet = FindWindowEx(PropRet, ByVal 0&, "Button", vbNullString)
                        'Check if we found buttons window of "VBAProject - Project Properties" window
                        If ChildRet <> 0 Then
                            'Get caption of 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 caption has word "OK"
                                If InStr(1, ButCap, "OK") Then
                                    'If this is button we are looking for then exit
                                    OpenRet = ChildRet
                                    Exit Do
                                End If
                                'KL: Activate remote VBE window to prevent losing control
                                xlAp.VBE.MainWindow.SetFocus
                                'Get handle of next child window
                                ChildRet = FindWindowEx(Ret, ChildRet, "Button", vbNullString)
                                'Get caption of child window
                                strBuff = String(GetWindowTextLength(ChildRet) + 1, Chr$(0))
                                GetWindowText ChildRet, strBuff, Len(strBuff)
                                ButCap = strBuff
                            Loop
                            'Check if we found OK button of "VBAProject - Project Properties" window
                            If OpenRet <> 0 Then
                                'Click OK Button to close "VBAProject - Project Properties" window
                                SendMessage ChildRet, BM_CLICK, 0, vbNullString
                            Else
                                MsgBox "Handle of OK Button of 'VBAProject - Project Properties' window Not Found"
                            End If
                        Else
                             MsgBox "Buttons window of 'VBAProject - Project Properties' Not Found"
                        End If
                    Else
                        MsgBox "Handle of 'VBAProject - Project Properties' window Not Found"
                    End If
    '***************************************************************************************
                Else
                    MsgBox "Handle of OK Button of 'VBAProject Password' window Not Found"
                End If
            Else
                 MsgBox "Buttons window of 'VBAProject Password' window Not Found"
            End If
        Else
            MsgBox "Edit Box of 'VBAProject Password' window Not Found"
        End If
    Else
        MsgBox "Handle of 'VBAProject Password' window was not Found"
    End If
End Sub

'Proc to click buttons or fill in textboxes found
Private Sub SendMess(Message As String, hwnd As Long)
    Call SendMessage(hwnd, WM_SETTEXT, False, ByVal Message)
End Sub