EXCEL VBA: Как программно установить пароль для другого VBProject

Question

Я создал код vba, который создает новый файл.xlms, добавив некоторый код в этот файл, и тогда моя проблема заключается в том, что я не могу защитить VBPoject этого нового файла. Вместо этого я ошибочно защищаю паролем текущий VBProject (а не новый, который я хочу). Вот мой код:

Sub Create_xlsm_File()

Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
Dim LineNum As Long
Dim ModuleName As String
Dim NewProcAsString As String
Dim myDir1 As String
Dim FileName1 As String
Dim FolderPath1 As String
Dim FilePath1 As String
Dim Pass1 As String
Dim SheetName1FileName1 As String
Dim MasterName As String
Dim NoOfSheets As Integer
Dim Newbook1 As Workbook

MasterName = Environ("UserName")
myDir1 = "C:\Users\" & MasterName & "\Desktop"
FileName1 = "LockedVBAProject"
Pass1 = "123"
NoOfSheets = 1
SheetName1FileName1 = "Sh1"
ModuleName = "Module1"
'----Creating and Save File-------------------------------------------
Set Newbook1 = Workbooks.Add
Newbook1.Activate
FilePath1 = myDir1 & "\" & FileName1
Application.SheetsInNewWorkbook = NoOfSheets
ActiveWorkbook.Sheets(1).Name = SheetName1FileName1
Newbook1.SaveAs Filename:=FilePath1, FileFormat:=xlOpenXMLWorkbookMacroEnabled, Password:=Pass1
Workbooks(FileName1).Close False
'----Add the VBA code to the File-------------------------------------
Application.Workbooks.Open (FilePath1), Password:=Pass1
Workbooks(FileName1).Activate
'=====================================================================
'This part is the problem. the SendKeys applied to current project and
' not to the desired "LockedVBAProject"
'=====================================================================
With Application
      '//execute the controls to lock the project\\
      .VBE.CommandBars("Menu Bar").Controls("Tools") _
                  .Controls("VBAProject Properties...").Execute

      '//activate 'protection'\\
      .SendKeys "^{TAB}", True

      '//CAUTION: this either checks OR UNchecks the\\
      '//"Lock Project for Viewing" checkbox, if it's already\\
      '//been locked for viewing, then this will UNlock it\\
      .SendKeys "{ }", True

      '//enter password (password is 123 in this example)\\
      .SendKeys "{TAB}" & "123", True

      '//confirm password\\
      .SendKeys "{TAB}" & "123", True

      '//scroll down to OK key\\
      .SendKeys "{TAB}", True

      '//click OK key\\
      .SendKeys "{ENTER}", True

      'the project is now locked - this takes effect
      'the very next time the book's opened...
End With
'=====================================================================
'=====================================================================
'=====================================================================

Set VBProj = ActiveWorkbook.VBProject
Set VBComp = VBProj.VBComponents.Add(vbext_ct_StdModule)
VBComp.Name = ModuleName
Set VBComp = VBProj.VBComponents("ThisWorkbook")
Set CodeMod = VBComp.CodeModule

With CodeMod
    LineNum = .CreateEventProc("Open", "Workbook")
    LineNum = LineNum + 2
    NewProcAsString = "MsgBox ""Hola !!!"""
    CodeMod.InsertLines LineNum, NewProcAsString
End With

Workbooks(FileName1).Save
Workbooks(FileName1).Close False


ThisWorkbook.Activate

End Sub

Не могли бы вы помочь мне выбрать и защитить паролем нужный новый файл "LockedVBAProject"? Любые другие предложения? Спасибо заранее за ваше время.

Answer 1

Поскольку кто-то вроде меня может наткнуться на этот пост в будущем, решение состоит в том, чтобы просто активировать соответствующий VBProject, используя следующее:

set Application.VBE.ActiveVBProject = Application.Workbooks(FileName1).VBProject

Тем не менее, приказ sendKeys()-commands не работает (по крайней мере у меня), так что вот всё как саб:

      Public Sub lockVBProject(wbName As String, password As String, locked As Boolean)
'set password for another workbooks VBA project via sendKeys method
'adapted from https://stackoverflow.com/questions/29937422/excel-vba-how-to-set-a-password-to-another-vbproject-programmaticaly
    
    With Application
        
        'select the appropriate VBProject        
        Set .VBE.ActiveVBProject = .Workbooks(wbName).VBProject
    
        'open project properties
        .VBE.CommandBars(1).FindControl(ID:=2578, recursive:=True).Execute

        'activate tab 'protection'
        .SendKeys "^{TAB}", True
                
        'mark checkbox
        .SendKeys "{TAB}", True
                
        'use space to select checkbox
        .SendKeys "{ }", True
        
        'unmark checkbox
        .SendKeys "{TAB}", True
                
        'enter password
        .SendKeys "{TAB}" & password, True
        
        'confirm password
        .SendKeys "{TAB}" & password, True
                
        'close dialog
        .SendKeys "{ENTER}", True
        
    End With

End Sub