Option Explicit
'Your password goes here!!!!
Const gszProjPassword As String = "hello"
Public Sub UnlockMe()
Dim wbName As Variant
Dim wbBook As Workbook
Dim vbaProj As Object
Dim oWin As Object
Dim X As Integer
On Error GoTo ErrorHandler
'Select the workbook with the project to unlock
wbName = Application.GetOpenFilename("Excel Files (*.xls),*.xls")
'Open it, assign an object ref to it's vba project
Set wbBook = Workbooks.Open(wbName)
Set vbaProj = wbBook.VBProject
'Close any open code windows
For Each oWin In vbaProj.VBE.Windows
If InStr(oWin.Caption, "(") > 0 Then oWin.Close
Next oWin
Application.VBE.MainWindow.Visible = False
'Check to see if the VBA project is already unlocked
If vbaProj.Protection <> 1 Then
MsgBox "The VBA Project for the file you selected is already unlocked.", 0
Exit Sub
'We found the project to be locked
ElseIf vbaProj.Protection = 1 Then
On Error Resume Next
Do While X < 4
If vbaProj.Protection <> 1 Then
MsgBox "The VBA project for " & wbName & " was unprotected successfully", 64
Exit Do
End If
UnprotectVBProject wbBook, gszProjPassword
X = X + 1
Loop
On Error GoTo 0
End If
ErrorExit:
Set wbBook = Nothing
Set vbaProj = Nothing
Exit Sub
ErrorHandler:
Select Case Err.Number
Case 1004
wbBook.Close False
MsgBox "You will need to set the " & _
"{ TRUST ACCESS TO VISUAL BASIC PROJECT } setting" & vbNewLine & _
"When the dialog appears, go to the Trusted Sources tab, " & _
"check the setting, click OK, and rerun this code again", 64
SendKeys "%T", True
SendKeys "M", True
SendKeys "S", True
Case Else
MsgBox Err.Description
End Select
Resume ErrorExit
End Sub
Public Sub UnprotectVBProject(wb As Workbook, ByVal Password As String)
Dim vbProj As Object
On Error GoTo ErrorHandler
Application.ScreenUpdating = False
Set vbProj = wb.VBProject
'Check to see if VBA project is already unlocked
If vbProj.Protection <> 1 Then Exit Sub
'Activate chosen VBA Project
Set Application.VBE.ActiveVBProject = vbProj
'SendKeys is the only way
If Password = "^^" Or Password = "++" Then
Password = ""
Exit Sub
ElseIf Right(Password, 2) = "^^" Or Right(Password, 2) = "++" Then
Password = ""
Exit Sub
Else
SendKeys Password & "~~" & "{ESC}"
Application.VBE.CommandBars(1).FindControl(ID:=2578, recursive:=True).Execute
End If
'Not the right password
If vbProj.Protection = 1 Then
SendKeys "%{F11}", True
End If
'Reset Password
Password = ""
Application.ScreenUpdating = True
Set vbProj = Nothing
Exit Sub
ErrorHandler:
MsgBox Err.Description, 64
End Sub