Hi,my friends,
My Problem is --
There're a batch of workbooks with the same konwn vba project password.how
to clear them at one time?

The following procedure can not work.

Sub UnprtVBA()
Dim filename As Variant
Dim PassWd As Variant
Dim thisbook As Workbook

Application.DisplayAlerts = False
Application.ScreenUpdating = False

filename = Application.GetOpenFilename("Excel Files (*.xls), *.xls", ,
"MultiSelect", MultiSelect:=True)
If VarType(filename) = vbBoolean Then Exit Sub

PassWd = Application.InputBox("If you the WorkBooks are proteced by a
password, enter it below" & Chr(13) & Chr(13) & "Leave the field blank if no
password is required", AT)
If PassWd = False Then Exit Sub

For i = 1 To UBound(filename)

Set thisbook = Workbooks.Open(filename(i))

Dim vbProj As Object
Set vbProj = thisbook.VBProject
If vbProj.Protection = 1 Then
Application.SendKeys "%{F11}", True
Application.SendKeys "%T", True
Application.SendKeys "e", True
myPW = PassWd
Application.SendKeys myPW, True
Application.SendKeys "{ENTER}", True
Application.SendKeys "{ENTER}", True
Application.SendKeys "%{F11}", True
End If

Application.SendKeys "%{F11}", True
Application.SendKeys "%T", True
Application.SendKeys "e", True
myPW = PassWd
Application.SendKeys "^{TAB}", True
Application.SendKeys "{-}", True
Application.SendKeys "{TAB}", True
Application.SendKeys "{DEL}", True
Application.SendKeys "{TAB}", True
Application.SendKeys "{DEL}", True
Application.SendKeys "{ENTER}", True
Application.SendKeys "%{F11}", True

thisbook.Save
thisbook.Close True
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub