А поиск вообще по этому поводу ничего не говорит?
Как программно снять пароль с VBA проекта?
Можно еще так попробовать (по-другому, но тоже SendKeys):
' Снимает защиту проекта. Идея: http://www.rondebruin.nl/
Private Sub UnprotectVBProject(wb As Workbook, ByVal Password As String)
Dim vbProj As Object, vbCtl As Object
Set vbProj = wb.VBProject
'can't do it if already unlocked!
If vbProj.Protection <> 1 Then
Exit Sub
End If
Set Application.VBE.ActiveVBProject = vbProj
If Application.VBE.ActiveVBProject.Name <> vbProj.Name Then
Exit Sub
End If
Set vbCtl = Application.VBE.CommandBars(1).FindControl(ID:=2578, recursive:=True)
With vbCtl
.Reset
.Execute
End With
SendKeys Password & "~~", True
End Sub
'что-то не срабатывает, ломает файлы. Не могли бы глянуть, может где ошибка вкралась?
Sub UnprotectVBProject(wb As Workbook, ByVal Password As String)
Dim vbProj As Object, vbCtl As Object
Set vbProj = wb.VBProject
'can't do it if already unlocked!
If vbProj.Protection <> 1 Then
Exit Sub
End If
Set Application.VBE.ActiveVBProject = vbProj
If Application.VBE.ActiveVBProject.Name <> vbProj.Name Then
Exit Sub
End If
Set vbCtl = Application.VBE.CommandBars(1).FindControl(ID:=2578, recursive:=True)
With vbCtl
.Reset
.Execute
End With
SendKeys Password & "~~", True
End Sub
Sub InsertModuleToTheWorkbooks()
Dim sFolder As String, sFiles As String
Dim CurrentModuleNumber As Long
Dim wbFDP As Workbook
Dim CurrentModule As String
Dim objVBProject As Object
Dim objVBComponent As Object
Dim objWindow As Object
sFolder = "C:\...\" 'folder path
sFiles = Dir(sFolder & "*.XLSM") 'file path
Do While sFiles <> ""
Set wbFDP = Workbooks.Open(sFolder & sFiles) 'open workbook
Set objVBProject = wbFDP.VBProject
UnprotectVBProject wbFDP, "123" 'unprotect VBA Project
'remove 5 old modules
For CurrentModuleNumber = 1 To 5
CurrentModule = "Module" & CurrentModuleNumber
With wbFDP.VBProject.VBComponents
.Remove wbFDP.VBProject.VBComponents(CurrentModule)
End With
Next CurrentModuleNumber
'install 6 new modules
For CurrentModuleNumber = 1 To 6
CurrentModule = "Module" & CurrentModuleNumber
With wbFDP.VBProject.VBComponents
.Import "C:\...\" & CurrentModule & ".bas" 'path to new modules
End With
Next CurrentModuleNumber
wbFDP.Close True
sFiles = Dir
Loop
Set objVBProject = Nothing: Set objWindow = Nothing
End Sub
'В Вашем коде из #11 есть цикл по удалению модулей с именами Module1-Module5. В книге из #1 есть только Module1. Если конец цикла в строке 44 изменить на 1, то при 'выполнении макроса с проекта снимается защита и удаляется Module1 (проверил). Вставку модулей не проверял.
