Send Keys to unlock a VBA Project Excel 2013

Question

Send Keys to unlock a VBA Project

Any I am somewhat advanced in macro writing, however it was all self-taught off this site and I don’t fully understand the big picture

I am trying to create an Excel spread sheet that will update the VBA code of another Excel spread sheet that has a password protected VBA Project. I am using SendKeys to unlock the VBA Project. I am also solving for SendKey deficiencies by writing scrip to close all open excel documents.

All the code I have written works on its own but when I try to combine it the SendKey macro is placing the password in other lines of code:

This works:

Sub UnprotectProject()
 With Application
 .SendKeys "%{F11}", True
 .SendKeys "^r", True
 .SendKeys "~", True
 .SendKeys "password", True
 .SendKeys "~", True
 End With
 End Sub

This inserts the password in other VBA Code:

Sub UnprotectProject()
 With Application
 .SendKeys "%{F11}", True
 .SendKeys "^r", True
 .SendKeys "~", True
 .SendKeys "password", True
 .SendKeys "~", True
 End With
 Application.VBE.MainWindow.Visible = False
 End Sub

Update:

Both sets of code are the same except for, the following line in the second example

Application.VBE.MainWindow.Visible = False

The full code I am trying to write has five tasks, I created a macro for each task, then another macro to run the five macros. Each macro does the intended job when run independently. However when I try to run the macro that combines the individual tasks, the macro with send keays is failing, and instead of unlocking the VBA Project it sticks the password in the code of one of the individual task macros These are the five tasks

1. Open (Opens the workbook to change)

2. Unprotect VBA Project

3. Update VBA Code

4. Update a Worksheet

5. SaveAs new version

This is the macro I wrote to run the individual tasks Sub UsernameCheck()

lastRow = Sheets("update").Range("I" & Rows.count).End(xlUp).Row
Uname = Environ("Username")
Set aCell = Sheets("update").Range("I4:I" & lastRow).Find(What:=Uname, MatchCase:=False)
If aCell Is Nothing Then
    MsgBox ("Not an Authorised User")
    Else
    Open_1
    UnprotectProject
    ChangeDateAddUserCheck
    UpdateDashBoard
    Save

End If

End Sub

This is the code I am using to edit a macro

Sub ChangeDateAddUserCheck()
  Dim VBComp As VBIDE.VBComponent
  Dim CodeMod As VBIDE.CodeModule
  Dim S As String
  Dim LineNum As Long

Set VBComp = ActiveWorkbook.VBProject.VBComponents("Module2")
  'Delete
  VBComp.CodeModule.DeleteLines 15, 4
  'add Code
  Set CodeMod = VBComp.CodeModule
  LineNum = 15
  S = "yr = Format(Now(), ""YYYYMMDD"")" & vbCrLf & _
      "If UCase(Sheets(""DashBoard"").Range(""B21"").Value) =      UCase(Environ(""Username"")) Then" & vbCrLf & _
      "If yr < 20160601 Then B2_Stage Else MsgBox (""Software is Expired"")" & vbCrLf & _
      "Else: MsgBox (""Not Authorized User"")" & vbCrLf & _
     "End If"
  CodeMod.InsertLines LineNum, S
End Sub

The password is being pasted in the code above between the folloing lines, but I think that has more to do with the placement of the Macro in the VBA Editor

Dim LineNum As Long

Set VBComp = ActiveWorkbook.VBProject.VBComponents("Module2")

Answer 1

Try this. The hint, for me at least, was in your comment:

[the] code for changing a macro doesn't work unless they are in the same excel instance

I modified it to deal with a different instance of Excel, which may be technically necessary here. I have observed some wonky things in the past using VBE extensibility, such as inserting text within the executing module at runtime (basically what you describe).

I also previously noticed some timing issues as the "Wait" argument of SendKeys method wasn't waiting, so I additionally use the WinAPI Sleep function to introduce a half-second lag after the SendKeys calls.

Note: You will need to modify your other functions to receive the wb Workbook argument, explicitly, and change references from ActiveWorkbook to wb, etc. (See how I changed ActiveWorkbook.VBProject to wb.VBProject, etc.)

Option Explicit
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Const slp As Long = 500

Sub Main()
Dim wb As Workbook
Dim xlApp As Application
Call Open_1("C:\debug\stack\protected.xlsm", xlApp, wb)
Call UnprotectProject(xlApp)
Call ChangeDateAddUserCheck(wb)

Set wb = Nothing
Set xlApp = Nothing

End Sub
Sub Open_1(filename$, xlApp As Excel.Application, wb As Workbook)
    Set xlApp = CreateObject("Excel.Application")
    Set wb = xlApp.Workbooks.Open(filename)
    xlApp.Visible = True
End Sub

Sub UnprotectProject(xlApp As Object)

    With xlApp
        .SendKeys "%{F11}", True
        Sleep slp
        .SendKeys "^r", True
        Sleep slp
        .SendKeys "~", True
        Sleep slp
        .SendKeys "password", True
        Sleep slp
        .SendKeys "~", True
        Sleep slp
    End With
End Sub
Sub ChangeDateAddUserCheck(wb As Workbook)
  Dim VBComp As Object 'VBIDE.VBComponent
  Dim CodeMod As Object 'VBIDE.CodeModule
  Dim S As String
  Dim LineNum As Long

Set VBComp = wb.VBProject.VBComponents("Module2")
  'Delete
  VBComp.CodeModule.DeleteLines 15, 4
  'add Code
  Set CodeMod = VBComp.CodeModule
  LineNum = 15
  S = "yr = Format(Now(), ""YYYYMMDD"")" & vbCrLf & _
      "If UCase(Sheets(""DashBoard"").Range(""B21"").Value) =      UCase(Environ(""Username"")) Then" & vbCrLf & _
      "If yr < 20160601 Then B2_Stage Else MsgBox (""Software is Expired"")" & vbCrLf & _
      "Else: MsgBox (""Not Authorized User"")" & vbCrLf & _
     "End If"
  CodeMod.InsertLines LineNum, S
End Sub

Pics or it didn't happen:

Here, you can see that your function ChangeDateAddUserCheck has introduced the S code string in to my workbook Protected.xlsm!Module2:

Follow-up:

I've declared wb and xlApp in the Main() sub. Then pass these objects to the Open_1 procedure, which will open the new Excel and the specified workbook path.

Then, any other subroutine which needs to operate on this wb or xlApp objects (such as ChangeDateAddUserCheck) you will modify so that it accepts a workbook object, for example:

Sub ChangeDateAddUserCheck(wb As Workbook)

And likewise, modifying the UnprotectProject signature so that it accepts the xlApp object:

Sub UnprotectProject(xlApp As Object)

how would I reference the workbook that this macro is living

As in my code, wb is scoped to the Main procedure (so is xlApp). If you need other procedures to handle these objects, you pass them to those procedures per above examples. You're basically saying, "[some procedure] will now take this wb object and do something with it"