Quote Originally Posted by theta
That one doesn't work. Freezes out :/ (Office 2010?)

Do you have an example workbook you can send with working code

The code works with a few tweaks

I just need to modify it so that I can use it for automation. I have put it into a loop but after a project is unlocked, the project properties window stays open.

So you have to ESC that, then click OK on the dialog saying the "Project was unlocked"

Could not see sendkeys in this code, so how would I capture and close the newely opened "VBAProject Properties" window? (the one presented after a correct password) ?



Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" ( _
ByVal hwndParent As Long, ByVal hwndChildAfter As Long, _
ByVal lpszClass As String, ByVal lpszWindow As String) As Long
Declare Function GetWindow Lib "user32" ( _
ByVal HWnd As Long, ByVal uCmd As Long) As Long
Declare Function GetParent Lib "user32" (ByVal HWnd As Long) As Long
Declare Function GetDlgItem Lib "user32" ( _
ByVal hDlg As Long, ByVal nIDDlgItem As Long) As Long
Declare Function GetDesktopWindow Lib "user32" () As Long
Declare Function SendMessage Lib "user32" Alias "SendMessageA" ( _
ByVal HWnd As Long, ByVal uMsg As Long, _
ByVal wParam As Long, lParam As Any) As Long
Declare Function SetFocusAPI Lib "user32" Alias "SetFocus" ( _
ByVal HWnd As Long) As Long
Declare Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Long) As Long
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Declare Function SetTimer Lib "user32" ( _
ByVal HWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Declare Function KillTimer Lib "user32" ( _
ByVal HWnd As Long, ByVal nIDEvent As Long) As Long
 
Public Const GW_CHILD = 5
Public Const WM_CLOSE = &H10
Public Const WM_SETTEXT = &HC
Public Const WM_GETTEXT = &HD
Public Const BM_GETCHECK = &HF0&
Public Const BM_SETCHECK = &HF1&
Public Const BST_CHECKED = &H1&
Public Const EM_REPLACESEL = &HC2
Public Const EM_SETSEL = &HB1
Public Const BM_CLICK = &HF5&
Public Const TCM_SETCURFOCUS = &H1330&
 
Private Const TimeoutSecond = 2
 
Private g_ProjectName    As String
Private g_Password       As String
Private g_hwndVBE        As Long
Private g_Result         As Long
Private g_hwndPassword   As Long
 
Public Function UnlockTimerProc(ByVal HWnd As Long, ByVal uMsg As Long, _
    ByVal idEvent As Long, ByVal dwTime As Long) As Long
    Dim hwndProjectProp As Long, hwndProjectProp2 As Long
    Dim hwndTab As Long, hwndLockProject As Long, hwndPassword As Long
    Dim hwndConfirmPassword As Long, hwndOK As Long
    Dim hwndtmp As Long, lRet As Long
    Dim IDTab As Long, IDLockProject As Long, IDPassword As Long
    Dim IDConfirmPassword As Long, IDOK As Long
    Dim sCaption          As String
    Dim timeout As Date, timeout2 As Date
    Dim pwd               As String
     
    On Error GoTo ErrorHandler
    KillTimer 0, idEvent
    IDTab = &H3020&
    IDLockProject = &H1557&
    IDPassword = &H155E&
    IDConfirmPassword = &H1556&
    IDOK = &H1&
    sCaption = " Password"
     
     'for the japanese version
    Select Case Application.LanguageSettings.LanguageID(msoLanguageIDUI)
    Case 1041
        sCaption = ChrW(&H30D7) & ChrW(&H30ED) & ChrW(&H30B8) & _
        ChrW(&H30A7) & ChrW(&H30AF) & ChrW(&H30C8) & _
        ChrW(&H20) & ChrW(&H30D7) & ChrW(&H30ED) & _
        ChrW(&H30D1) & ChrW(&H30C6) & ChrW(&H30A3)
    End Select
     
    sCaption = g_ProjectName & sCaption
    Debug.Print sCaption
    timeout = Now() + TimeSerial(0, 0, TimeoutSecond)
    Do While Now() < timeout
         
        hwndProjectProp = 0
        hwndProjectProp2 = 0
        hwndTab = 0
        hwndLockProject = 0
        hwndPassword = 0
        hwndConfirmPassword = 0
        hwndOK = 0
         
        hwndtmp = 0
        Do
            hwndtmp = FindWindowEx(0, hwndtmp, vbNullString, sCaption)
            If hwndtmp = 0 Then Exit Do
        Loop Until GetParent(hwndtmp) = g_hwndVBE
        If hwndtmp = 0 Then GoTo Continue
        Debug.Print "found window"
        lRet = SendMessage(hwndtmp, TCM_SETCURFOCUS, 1, ByVal 0&)
         
        hwndPassword = GetDlgItem(hwndtmp, IDPassword)
        Debug.Print "hwndpassword: " & hwndPassword
         '        hwndConfirmPassword = GetDlgItem(hwndProjectProp2, IDConfirmPassword)
        hwndOK = GetDlgItem(hwndtmp, IDOK)
        Debug.Print "hwndOK: " & hwndOK
        If (hwndtmp _
        And hwndOK) = 0 Then GoTo Continue
         
        lRet = SetFocusAPI(hwndPassword)
        lRet = SendMessage(hwndPassword, EM_SETSEL, 0, ByVal -1&)
        lRet = SendMessage(hwndPassword, EM_REPLACESEL, 0, ByVal g_Password)
         
        pwd = String(260, Chr(0))
        lRet = SendMessage(hwndPassword, WM_GETTEXT, Len(pwd), ByVal pwd)
        pwd = Left(pwd, InStr(1, pwd, Chr(0), 0) - 1)
        If pwd <> g_Password Then GoTo Continue
         
         
        lRet = SetFocusAPI(hwndOK)
        lRet = SendMessage(hwndOK, BM_CLICK, 0, ByVal 0&)
         
        g_Result = 1
        Exit Do
         
Continue:
        DoEvents
        Sleep 100
    Loop
     '    Exit Function
     
ErrorHandler:
    If hwndPassword <> 0 Then SendMessage hwndPassword, WM_CLOSE, 0, ByVal 0&
    LockWindowUpdate 0
End Function

Function UnlockProject(ByVal Project As Object, ByVal Password As String) As Long
    Dim timeout           As Date
    Dim lRet              As Long
     
    On Error GoTo ErrorHandler
    UnlockProject = 1
    'If Project.Protection <> vbext_pp_locked Then
    If Project.Protection <> 1 Then
        UnlockProject = 2
        Exit Function
    End If
    
    g_ProjectName = Project.Name
    g_Password = Password
     '    LockWindowUpdate GetDesktopWindow()
    Application.VBE.MainWindow.Visible = True
    g_hwndVBE = Application.VBE.MainWindow.HWnd
    g_Result = 0
    lRet = SetTimer(0, 0, 100, AddressOf UnlockTimerProc)
    If lRet = 0 Then
        Debug.Print "error setting timer"
        GoTo ErrorHandler
    End If
    Set Application.VBE.ActiveVBProject = Project
    If Not Application.VBE.ActiveVBProject Is Project Then
        GoTo ErrorHandler
    End If
    Application.VBE.CommandBars.FindControl(ID:=2578).Execute
     
    timeout = Now() + TimeSerial(0, 0, TimeoutSecond)
    Do While g_Result = 0 And Now() < timeout
        DoEvents
    Loop
    If g_Result Then UnlockProject = 0
    AppActivate Application.Caption
    LockWindowUpdate 0
    Exit Function
     
ErrorHandler:
    AppActivate Application.Caption
    LockWindowUpdate 0
End Function
 
Sub Test_UnlockProject()
    Select Case UnlockProject(ActiveWorkbook.VBProject, "password")
    Case 0: MsgBox "The project was unlocked."
    Case 2: MsgBox "The active project was already unlocked."
    Case Else: MsgBox "Error or timeout."
    End Select
End Sub