EXCEL VBA: How to set a password to another VBProject programmaticaly

Jimmy1966

New Member
Joined
Apr 29, 2015
Messages
1


I have created a vba code that creates a new .xlms file, adding some code to that file and then my problem is that i cannot protect the VBPoject of that new file. Instead, i wrongly password protect the current VBProject (not the new one, that i want). Here is my code:
<code>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</code> Can you please help me to select and password protect the desired new "LockedVBAProject" file?
Any other suggestions?
Thanks in advance for your time.




<tbody>
</tbody>
 

Forum statistics

Threads
1,081,556
Messages
5,359,547
Members
400,533
Latest member
fpenning

Some videos you may like

This Week's Hot Topics

  • VBA (Userform)
    Hi All, I just would like to know why my code isn't working. Here is my VBA code: [CODE=vba]Private Sub OKButton_Click() Dim i As Integer...
  • List box that changes fill color
    Hello, I have gone through so many pages trying to figure this out. I have a 2020 calendar that depending on the day needs to have a certain...
  • Remove duplicates and retain one. Cross-linked cases
    Hi all I ran out of google keywords to use and still couldn't find a reference how to achieve the results of a single count. It would be great if...
  • VBA Copy and Paste With Duplicates
    Hello All, I'm in need of some input. My VBA skills are sub-par at best. I've assembled this code from basic research and it works but is...
  • Macro
    is it possible for a macro to run if the active cell value is different to the value above it
  • IF DATE and TIME
    I currently use this to check if date has passed but i also need to set a time on it too. Is it possible? [CODE=vba]=IF(B:B>TODAY(),"Not...
Top