Sleeper: Password protect VBA Project in Script

[brianlois]

Hello,

I am needing to password protect the VBA Project in each Excel file that I open in my script below. Is there anyway to code this so I can use the same password to protect (lock for viewing) the VBA project in each file??



Sub FindClientExcelFiles()
Dim FS As Office.FileSearch
Dim vaFileName As Variant
Dim startdir
Dim enddir
Dim Foo As Object
Dim iCount As Long
Dim newname As Variant
Dim fsoObj As Object, TheDate As String
TheDate = Format(Date, "YYYYMMDD")
startdir = "C:\Temp\1"
enddir = ("C:\Temp\" & TheDate & "\")
Set fsoObj = CreateObject("Scripting.FileSystemObject")
With fsoObj
If Not .FolderExists(enddir) Then
.CreateFolder (enddir)
End If
End With
Set FS = Application.FileSearch
With FS
'Clear old search criteria
.NewSearch
'Directory to search
.LookIn = startdir
'Include sub folders in search
.SearchSubFolders = True
'Look for Excel files
.FileType = msoFileTypeExcelWorkbooks
'Doesn't matter when last modified
.LastModified = msoLastModifiedAnyTime
iCount = .Execute
'List the files in the FoundFiles collection
For Each vaFileName In .FoundFiles
Set Foo = Workbooks.Open(vaFileName)
Application.DisplayAlerts = False
Foo.SaveAs enddir & Foo.Name
Foo.Close
Application.DisplayAlerts = True
Kill vaFileName
Next vaFileName
End With
End Sub

[Anne Troy]

This procedure tells you how to process all files in a directory. Perhaps you can combine yours and this one?

http://www.vbaexpress.com/kb/getarticle.php?kb_id=9

[Killian]

The Protection property of the VBProject object is Read-Only and the SaveAs method can only be used on standalone projects so I don't really see a way of doing this programatically, I'm afraid...

[Paleo]

I think the only way you may do this is by setting the Alt + F11 and Alt + F8 keys combination to run a macro from yours and then using an InputBox ask for a password, if its right you open the VBE else you give an error message back. Also you will need to disable Tools - Macro.

Hard to code but will do what you need.

[Jacob Hilderbrand]

As usual there is a way to do this, however, it does require using SendKeys which I normally would not recommend. But you gotta do what you gotta do.


Option Explicit
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub ProtectAll()
Dim objFSO As FileSystemObject
Dim objFolder As Folder
Dim intFileCnt As Integer
Dim objFiles As Files
Dim objFile As File
Dim strPassWord As String
Dim intTotFiles As Integer
Dim objExApp As Excel.Application
Dim objWB As Workbook
strPassWord = "MyPassword"
Set objFSO = New FileSystemObject
Set objFolder = objFSO.GetFolder("C:\Test")
Set objFiles = objFolder.Files
Set objExApp = New Excel.Application
intTotFiles = objFiles.Count
objExApp.Visible = True
For Each objFile In objFiles
Set objWB = objExApp.Workbooks.Open(objFile.Path)
With objWB
With .VBProject.VBE.MainWindow
.Visible = True
.SetFocus
SendKeys "%t": Sleep 50: DoEvents
SendKeys "e": Sleep 50: DoEvents
SendKeys "^{TAB}": Sleep 50: DoEvents
SendKeys "%v": Sleep 50: DoEvents
SendKeys "{TAB}": Sleep 50: DoEvents
SendKeys strPassWord: Sleep 50: DoEvents
SendKeys "{TAB}": Sleep 50: DoEvents
SendKeys strPassWord: Sleep 50: DoEvents
SendKeys "{TAB}": Sleep 50: DoEvents
SendKeys "~": Sleep 50: DoEvents
End With
.Close True
End With
Next
End Sub

You need to set a reference to the Microsoft Scripting Runtime.

[brianlois]

Thanks Jake. I am getting compile errors when trying to run this code. Do I need to do anything else to reference the Microsoft Scripting Runtime??



Option Explicit
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) << compile error

Sub ProtectAll()
Dim objFSO As FileSystemObject << compile error
Dim objFolder As Folder
Dim intFileCnt As Integer
Dim objFiles As Files
Dim objFile As File
Dim strPassWord As String
Dim intTotFiles As Integer
Dim objExApp As Excel.Application
Dim objWB As Workbook
strPassWord = "MyPassword"
Set objFSO = New FileSystemObject
Set objFolder = objFSO.GetFolder("C:\Temp\1")
Set objFiles = objFolder.Files
Set objExApp = New Excel.Application
intTotFiles = objFiles.Count
objExApp.Visible = True
For Each objFile In objFiles
Set objWB = objExApp.Workbooks.Open(objFile.Path)
With objWB
With .VBProject.VBE.MainWindow
.Visible = True
.SetFocus
SendKeys "%t": Sleep 50: DoEvents
SendKeys "e": Sleep 50: DoEvents
SendKeys "^{TAB}": Sleep 50: DoEvents
SendKeys "%v": Sleep 50: DoEvents
SendKeys "{TAB}": Sleep 50: DoEvents
SendKeys strPassWord: Sleep 50: DoEvents
SendKeys "{TAB}": Sleep 50: DoEvents
SendKeys strPassWord: Sleep 50: DoEvents
SendKeys "{TAB}": Sleep 50: DoEvents
SendKeys "~": Sleep 50: DoEvents
End With
.Close True
End With
Next
End Sub

[Jacob Hilderbrand]

In the VBE select Tools | References. Then scroll down to Microsoft Scripting Runtime and check it.

[Paleo]

What if the user opens the workbook pressing the Shift key?

[brianlois]

Still trying to use sendkeys to password protect the VBA project in each Excel file I open. I am receiving an error at "With .VBProject.VBE.MainWindow". Am I doing something wrong? Or is something not defined?


Sub FindClientExcelFiles()
Dim FS As Office.FileSearch
Dim vaFileName As Variant
Dim startdir
Dim enddir
Dim Foo As Object
Dim iCount As Long
Dim newname As Variant
Dim fsoObj As Object, TheDate As String
Dim strPassWord As String
TheDate = Format(Date, "YYYYMMDD")
startdir = "C:\Temp\1"
enddir = ("C:\Temp\" & TheDate & "\")
strPassWord = "Graycon"
Set fsoObj = CreateObject("Scripting.FileSystemObject")
With fsoObj
If Not .FolderExists(enddir) Then
.CreateFolder (enddir)
End If
End With
Set FS = Application.FileSearch
With FS
'Clear old search criteria
.NewSearch
'Directory to search
.LookIn = startdir
'Include sub folders in search
.SearchSubFolders = True
'Look for Excel files
.FileType = msoFileTypeExcelWorkbooks
'Doesn't matter when last modified
'.LastModified = TimeSerial(Hour(Time), Minute(Time) - 5, Second(Time))
iCount = .Execute
'List the files in the FoundFiles collection
For Each vaFileName In .FoundFiles
If FileDateTime(vaFileName) < Now() - 2 / (24 * 60) Then
Set Foo = Workbooks.Open(vaFileName)
With .VBProject.VBE.MainWindow
.Visible = True
.SetFocus
Application.SendKeys "%t", Wait
Application.SendKeys "m", Wait
Application.SendKeys "v", Wait
Application.SendKeys "%t", Wait
Application.SendKeys "e", Wait
Application.SendKeys "^{TAB}", Wait
Application.SendKeys "%v", Wait
Application.SendKeys "{TAB}", Wait
Application.SendkeysstrPassWord , Wait
Application.SendKeys "{TAB}", Wait
Application.SendkeysstrPassWord , Wait
Application.SendKeys "{TAB}", Wait
Application.SendKeys "~", Wait
DoEvents
End With
.Close True
Application.DisplayAlerts = False
Foo.SaveAs enddir & Foo.Name
Foo.Close
Application.DisplayAlerts = True
Kill vaFileName
End If
Next vaFileName
End With
End Sub

[Richie(UK)]

Hi Brian,

Which workbook do you think is being referenced by the line :
.VBProject.VBE.MainWindow ?

It looks as if your intention is the Foo workbook. Either use Foo.VBProject.VBE.MainWindow
or use Foo in a With statement before that line (like Jake did with the objWB variable).

HTH

PS. Do keep in mind that SendKeys is not a 100% reliable approach. Its OK if the only person concerned is you, but if the code may impact upon others be very wary. ;)

[brianlois]

Thanks Richie. It worked, but the sendkeys are trying to protect the VBA Project for the Macro that I am running and not each Excel that I open. How can I have the sendkeys just execute in each Excel that I open and not in my Macro itself? Sorry for all the questions. Thanks for your help.

Brian



Sub FindClientExcelFiles()
Dim FS As Office.FileSearch
Dim vaFileName As Variant
Dim startdir
Dim enddir
Dim Foo As Object
Dim iCount As Long
Dim newname As Variant
Dim fsoObj As Object, TheDate As String
Dim strPassWord As String
TheDate = Format(Date, "YYYYMMDD")
startdir = "C:\Temp\1"
enddir = ("C:\Temp\" & TheDate & "\")
strPassWord = "Graycon"
Set fsoObj = CreateObject("Scripting.FileSystemObject")
With fsoObj
If Not .FolderExists(enddir) Then
.CreateFolder (enddir)
End If
End With
Set FS = Application.FileSearch
With FS
'Clear old search criteria
.NewSearch
'Directory to search
.LookIn = startdir
'Include sub folders in search
.SearchSubFolders = True
'Look for Excel files
.FileType = msoFileTypeExcelWorkbooks
'Doesn't matter when last modified
'.LastModified = TimeSerial(Hour(Time), Minute(Time) - 5, Second(Time))
iCount = .Execute
'List the files in the FoundFiles collection
For Each vaFileName In .FoundFiles
If FileDateTime(vaFileName) < Now() - 2 / (24 * 60) Then
Set Foo = Workbooks.Open(vaFileName)
With Foo
With Foo.VBProject.VBE
'.Visible = True
'.SetFocus
Application.SendKeys "%t", Wait
Application.SendKeys "m", Wait
Application.SendKeys "v", Wait
Application.SendKeys "%t", Wait
Application.SendKeys "e", Wait
Application.SendKeys "^{TAB}", Wait
Application.SendKeys "%v", Wait
Application.SendKeys "{TAB}", Wait
Application.SendkeysstrPassWord , Wait
Application.SendKeys "{TAB}", Wait
Application.SendkeysstrPassWord , Wait
Application.SendKeys "{TAB}", Wait
Application.SendKeys "~", Wait
'.Close True
End With
End With
Application.DisplayAlerts = False
Foo.SaveAs enddir & Foo.Name
Foo.Close
Application.DisplayAlerts = True
Kill vaFileName
End If
Next vaFileName
End With
End Sub

[Howard Kaikow]

Still trying to use sendkeys to password protect the VBA project in each Excel file I open. I am receiving an error at "With .VBProject.VBE.MainWindow". Am I doing something wrong? Or is something not defined?


Sub FindClientExcelFiles()
Dim FS As Office.FileSearch
Dim vaFileName As Variant
Dim startdir
Dim enddir
Dim Foo As Object
Dim iCount As Long
Dim newname As Variant
Dim fsoObj As Object, TheDate As String
Dim strPassWord As String
TheDate = Format(Date, "YYYYMMDD")
startdir = "C:\Temp\1"
enddir = ("C:\Temp\" & TheDate & "\")
strPassWord = "Graycon"
Set fsoObj = CreateObject("Scripting.FileSystemObject")
With fsoObj
If Not .FolderExists(enddir) Then
.CreateFolder (enddir)
End If
End With
Set FS = Application.FileSearch
With FS
'Clear old search criteria
.NewSearch
'Directory to search
.LookIn = startdir
'Include sub folders in search
.SearchSubFolders = True
'Look for Excel files
.FileType = msoFileTypeExcelWorkbooks
'Doesn't matter when last modified
'.LastModified = TimeSerial(Hour(Time), Minute(Time) - 5, Second(Time))
iCount = .Execute
'List the files in the FoundFiles collection
For Each vaFileName In .FoundFiles
If FileDateTime(vaFileName) < Now() - 2 / (24 * 60) Then
Set Foo = Workbooks.Open(vaFileName)
With .VBProject.VBE.MainWindow
.Visible = True
.SetFocus
Application.SendKeys "%t", Wait
Application.SendKeys "m", Wait
Application.SendKeys "v", Wait
Application.SendKeys "%t", Wait
Application.SendKeys "e", Wait
Application.SendKeys "^{TAB}", Wait
Application.SendKeys "%v", Wait
Application.SendKeys "{TAB}", Wait
Application.SendkeysstrPassWord , Wait
Application.SendKeys "{TAB}", Wait
Application.SendkeysstrPassWord , Wait
Application.SendKeys "{TAB}", Wait
Application.SendKeys "~", Wait
DoEvents
End With
.Close True
Application.DisplayAlerts = False
Foo.SaveAs enddir & Foo.Name
Foo.Close
Application.DisplayAlerts = True
Kill vaFileName
End If
Next vaFileName
End With
End Sub


You need to add a reference to the Extensibility 5.3 library, but, as I recall, and I think Killian already stated, you cannot change that property at Run time.

But, I've not checked this in a looooong time, so I'm not sure.

my recollection is that you can change the password in the project in which the macro itself is running, perhaps not in other projects.

anybody here ever test this?

[Richie(UK)]

... my recollection is that you can change the password in the project in which the macro itself is running, perhaps not in other projects.

anybody here ever test this?
Hi Howard,

My recollection (again, its been a while since I tested it) is that you can do this with multiple workbooks/projects. The key issue is that a delay is needed in the code to allow for the fact that SendKeys is being used. I first saw this here (http://www.mrexcel.com/board2/viewtopic.php?t=32331&highlight=vbproject+sendkeys+sleep) (it looks as if this is where Jake saw it too). I remember testing it at the time - it does work! ;)

[Howard Kaikow]

Hi Howard,

My recollection (again, its been a while since I tested it) is that you can do this with multiple workbooks/projects. The key issue is that a delay is needed in the code to allow for the fact that SendKeys is being used. I first saw this here (http://www.mrexcel.com/board2/viewtopic.php?t=32331&highlight=vbproject+sendkeys+sleep) (it looks as if this is where Jake saw it too). I remember testing it at the time - it does work! ;)

In that thread, and in the referenced John Walkenbach article, it is pointed out that you cannot rely on SendKeys.

A few years ago, I tried to come up with SendKeys (for a different Dialog) that would work across versions, I even used a different SendKeys for each Word version. Could not guarantee results. I believe that the phase of the moon and low/high tides are factors.

Not to mention that it is very likely that some auntie virus program will flag code attempting to change passwords, if not when you design the code, later when there is an update to the AV software/virus definitions.



Not to mention that it is very likely that some auntie virus program will flag code attempting to change passwords, if not when you design the code, later when there is an update to the AV software/virus definitions.

Forgot to mention that use of the Scripting runtime oft triggers AV software warnings.

Better to find another way than use Scripting library.

[Richie(UK)]

In that thread, and in the referenced John Walkenbach article, it is pointed out that you cannot rely on SendKeys.Absolutely right, I certainly wouldn't recommend it in any serious project. As a workaround, provided you accept its limitations, it has its uses ... if you are desparate. ;)


A few years ago, I tried to come up with SendKeys (for a different Dialog) that would work across versions, I even used a different SendKeys for each Word version. Could not guarantee results. I believe that the phase of the moon and low/high tides are factors.Ah, I see. I knew I was missing some vital piece of information. :)

[Howard Kaikow]

Absolutely right, I certainly wouldn't recommend it in any serious project. As a workaround, provided you accept its limitations, it has its uses ... if you are desparate. ;)

Ah, I see. I knew I was missing some vital piece of information. :)

Although I have no intention of moving to Wysteria Lane, I got desperate and decided to play with the code suggested earlier in this thread.

First, I converted the code to use Word, instead of Excel.

I noticed the following:.

1. The FileSystemObject seems to have a mind of its own. Depending on timing of operations, it would sometimes cycle back and present files on which the code had already operated.

For example, if I have 3 .dot files, it would present each of the files, operate on the files, and then present the files again.

Since AV software often does not like the Scripting runtime, its better to use something else. For Word, I chose to cycle thru the files using DIR(). Another alternative could be the ComDLG control.

2. It is not necessary for the Word app to be visible, but it is necessary to allow the design window to be visible. Alas, this has the problem of annoying screen changes flashing by.

There does not seem to be an equivalent of Screenupdating for the design window. I tried minimizing the design window, but that caused the password to not be saved.

3. One has to take care not to operate on other than, in the case of Word, Word documents and templates. Actually, I'm limiting the files to .dot. Too much trouble to try to filter out others.

4. It is necessary to check whether a project is already protected before attempting to set the password. I suspect that there is a SendKeys sequence for entering a password. At some point, I'll look into that.

[JonPeltier]

1. The FileSystemObject seems to have a mind of its own. Depending on timing of operations, it would sometimes cycle back and present files on which the code had already operated.

For example, if I have 3 .dot files, it would present each of the files, operate on the files, and then present the files again.

Since AV software often does not like the Scripting runtime, its better to use something else. For Word, I chose to cycle thru the files using DIR(). Another alternative could be the ComDLG control.
Even with Dir(), it's best to use it quickly to populate an array of filenames, then loop on the filenames. If you work on each file as Dir presents it, sometimes it "resets" Dir, and you'll see the file again. I wonder if FSO is the same way.


2. It is not necessary for the Word app to be visible, but it is necessary to allow the design window to be visible. Alas, this has the problem of annoying screen changes flashing by.

There does not seem to be an equivalent of Screenupdating for the design window. I tried minimizing the design window, but that caused the password to not be saved.
I believe through the mysterious Windows API you can activate the window to allow SendKeys to send keys to it, while not updating the display of the monitor. This sounds scary, though. I'd practice on a very small scale first.

[Howard Kaikow]

Even with Dir(), it's best to use it quickly to populate an array of filenames, then loop on the filenames. If you work on each file as Dir presents it, sometimes it "resets" Dir, and you'll see the file again. I wonder if FSO is the same way.

The evidence would make it seem so.


I believe through the mysterious Windows API you can activate the window to allow SendKeys to send keys to it, while not updating the display of the monitor. This sounds scary, though. I'd practice on a very small scale first.

Every time I've seen this issue discussed, the conclusion was always that the DESKTOP had to be locked, not just the relevant windows.

And the problem is even deeper.

Using VB 6 to automate Word, the SendKeys solution seems to work when running from VB 6 design mode, but not from a .exe. Until the latter problem is solved, doesn't make much sense to use SendKeys from VB 6 to control Word.

I started investigating the possibility of VB 6 running a Word macro that does the deed, but there are issues not yet resolved.

I have to put this stuff aside for a few weeks,

It's too easy to get sucked into this stuff.

In this case, it's not really worth the time because VBA project passwords don't really mean much.

[XL-Dennis]

In this case, it's not really worth the time because VBA project passwords don't really mean much.


True and especially if the follow up question would be:

"I got 15 VB-projects I need to update and all of them are protected. There are distributed among 120 end-users within the organisation nationswide." It's a must to do it with automation..." ;)

Kind regards,
Dennis

[JonPeltier]

"I got 15 VB-projects I need to update and all of them are protected. There are distributed among 120 end-users within the organisation nationswide." It's a must to do it with automation..."
This is why one must design solutions that completely separate the data from the code. It's harder to do, but good programming means you have to do the hard thing to make it easier for the users.

Unlocking a VBA project to change the code is possible but cumbersome, and Office 2003 (and perhaps XP) requires additional security systems to be overcome (e.g., Trust access to the VB Project). It's an easier and more reliable upgrade to revise and redistribute the coded portion of the solution, leaving the user's data intact.

[Howard Kaikow]

In my case, I have created a VB 6 program to install a Word template and DLL. To do this, the program needs to add a reference to the template..

After about 5 hours of sleep, I looked at the problem anew and seem to have a solution for adding a password to an extant project.

The code below works in a Word template, in VB 6 in design mode, and, most importantly, in a VB 6 .exe.

The ONLY difference between using the code in Word or in VB 6 is in the setup of the Application object.

Below is the code from the Word template version.

NOTE: The template MUST be dirtied to contain at least one module, otherwise the password will not be set. In practice, this should not be a problem, as I expect that the project is being protected because it contains code.

In my example, I am creating a fresh template, so I had to dirty the project with code. Of course, the project will contain code, so this is just an issue of requiring addition of code before setting the password.



Option Explicit

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Sub TestIt()
Const strPath As String = "C:\Test\PasswordOriginal\"
Dim appWord As Word.Application
Dim docWord As Word.Document
Dim strFile As String

strFile = strPath & "TestMe.dot"

' Set appWord = New Word.Application ' For VB 6
Set appWord = Application ' For Microsodt Word
Set docWord = appWord.Documents.Add(NewTemplate:=True, DocumentType:=wdNewBlankDocument, Visible:=False)
With docWord
.SaveAs FileName:=strFile, FileFormat:=wdFormatTemplate, addtorecentfiles:=False
.Close
End With
' appWord.Quit ' For VB 6
Set appWord = Nothing
Set docWord = Nothing
ProtectSingleProject
End Sub

Private Sub ProtectSingleProject()
' This works: Do not change
Const strPath As String = "C:\Test\Password\"
Const strPathOriginal As String = "C:\Test\PasswordOriginal\"
Const strTemplate As String = "TestMe.dot"
Dim appWord As Word.Application
Dim docWord As Word.Document
Dim strFile As String
Dim strFileOriginal As String
Dim strPassword As String

strPassword = "mypassword"
Set appWord = New Word.Application ' For BOTH VB 6 and Microsodt Word
With appWord
.Visible = True
End With

strFile = strPath & strTemplate
strFileOriginal = strPathOriginal & strTemplate
If Len(Dir(strFileOriginal)) <> 0 Then
On Error Resume Next
Kill strFile
On Error GoTo 0
FileCopy strFileOriginal, strFile
Set docWord = appWord.Documents.Open(strFile)
With docWord
With .VBProject
If .Protection = vbext_pp_none Then
' Add Modules
With .VBComponents
' Add Module
With .Add(vbext_ct_StdModule)
.Name = "modKeep"
With .CodeModule
If .CountOfDeclarationLines <> 0 Then
.DeleteLines Startline:=1, Count:=.CountOfDeclarationLines
End If
.AddFromString ("Option Explicit")
.AddFromString ("Private Declare Sub Sleep Lib " & Chr$(34) & _
"kernel32" & Chr$(34) & "(ByVal dwMilliseconds As Long)")
.InsertLines .CountOfLines + 1, "Public Sub SetPassword()"
.InsertLines .CountOfLines + 1, vbTab & _
"With Application.VBE.ActiveVBProject"
.InsertLines .CountOfLines + 1, vbTab & vbTab & _
"If .Protection = vbext_pp_none Then"
.InsertLines .CountOfLines + 1, vbTab & vbTab & vbTab & _
"With .VBE.MainWindow"
.InsertLines .CountOfLines + 1, vbTab & vbTab & vbTab & vbTab & _
".Visible = True"
.InsertLines .CountOfLines + 1, vbTab & vbTab & vbTab & vbTab & _
".SetFocus"
.InsertLines .CountOfLines + 1, vbTab & vbTab & vbTab & vbTab & _
"SendKeys " & Chr$(34) & "%t" & Chr$(34) & _
": Sleep 50: DoEvents"
.InsertLines .CountOfLines + 1, vbTab & vbTab & vbTab & vbTab & _
"SendKeys " & Chr$(34) & "e" & Chr$(34) & _
": Sleep 50: DoEvents"
.InsertLines .CountOfLines + 1, vbTab & vbTab & vbTab & vbTab & _
"SendKeys " & Chr$(34) & "^{TAB}" & Chr$(34) & _
": Sleep 50: DoEvents"
.InsertLines .CountOfLines + 1, vbTab & vbTab & vbTab & vbTab & _
"SendKeys " & Chr$(34) & "%v" & Chr$(34) & _
": Sleep 50: DoEvents"
.InsertLines .CountOfLines + 1, vbTab & vbTab & vbTab & vbTab & _
"SendKeys " & Chr$(34) & "{TAB}" & Chr$(34) & _
": Sleep 50: DoEvents"
.InsertLines .CountOfLines + 1, vbTab & vbTab & vbTab & vbTab & _
"SendKeys " & Chr$(34) & strPassword & Chr$(34) & _
": Sleep 50: DoEvents"
.InsertLines .CountOfLines + 1, vbTab & vbTab & vbTab & vbTab & _
"SendKeys " & Chr$(34) & "{TAB}" & Chr$(34) & _
": Sleep 50: DoEvents"
.InsertLines .CountOfLines + 1, vbTab & vbTab & vbTab & vbTab & _
"SendKeys " & Chr$(34) & strPassword & Chr$(34) & _
": Sleep 50: DoEvents"
.InsertLines .CountOfLines + 1, vbTab & vbTab & vbTab & vbTab & _
"SendKeys " & Chr$(34) & "{TAB}" & Chr$(34) & _
": Sleep 50: DoEvents"
.InsertLines .CountOfLines + 1, vbTab & vbTab & vbTab & vbTab & _
"SendKeys " & Chr$(34) & "~" & Chr$(34) & _
": Sleep 50: DoEvents"
.InsertLines .CountOfLines + 1, vbTab & vbTab & vbTab & "End With"
.InsertLines .CountOfLines + 1, vbTab & vbTab & "End If"
.InsertLines .CountOfLines + 1, vbTab & "End With"
.InsertLines .CountOfLines + 1, "End Sub"
End With
End With
' Add Module
With .Add(vbext_ct_StdModule)
.Name = "modTemp"
With .CodeModule
If .CountOfDeclarationLines <> 0 Then
.DeleteLines Startline:=1, Count:=.CountOfDeclarationLines
End If
.AddFromString ("Option Explicit")
.InsertLines .CountOfLines + 1, "Public Sub SetReference()"
.InsertLines .CountOfLines + 1, vbTab & _
"Const strDLLPath as String = " & Chr$(34) & _
"J:\Program Files\Common Files\Microsoft Shared\VBA\VBA6\VBE6EXT.OLB" & Chr$(34)
.InsertLines .CountOfLines + 1, vbTab & _
"Const strDLL as String = " & Chr$(34) & "VBE6EXT.OLB" & Chr$(34)
.InsertLines .CountOfLines + 1, vbTab & "On Error Resume Next"
.InsertLines .CountOfLines + 1, vbTab & _
"With Application.VBE.ActiveVBProject.References"
.InsertLines .CountOfLines + 1, vbTab & vbTab & _
".Remove Application.VBE.ActiveProject.References.Item(strDLL)"
.InsertLines .CountOfLines + 1, vbTab & vbTab & _
".AddFromFile FileName:=strDLLPath"
.InsertLines .CountOfLines + 1, vbTab & "End With"
.InsertLines .CountOfLines + 1, vbTab & "Err.Clear"
.InsertLines .CountOfLines + 1, "End Sub"
End With
End With
End With
With .VBE.MainWindow
.Visible = True
.SetFocus
SendKeys "%t": Sleep 50: DoEvents
SendKeys "e": Sleep 50: DoEvents
SendKeys "^{TAB}": Sleep 50: DoEvents
SendKeys "%v": Sleep 50: DoEvents
SendKeys "{TAB}": Sleep 50: DoEvents
SendKeys strPassword: Sleep 50: DoEvents
SendKeys "{TAB}": Sleep 50: DoEvents
SendKeys strPassword: Sleep 50: DoEvents
SendKeys "{TAB}": Sleep 50: DoEvents
SendKeys "~": Sleep 50: DoEvents
End With
With docWord
With .VBProject
.VBComponents.Remove .VBComponents("modTemp")
End With
.AttachedTemplate.Save
.Save
End With
End If
End With
.Close
End With
End If

appWord.Quit
Set docWord = Nothing
Set appWord = Nothing
End Sub

[JonPeltier]

Anybody here understand the Windows API? I use it as much as anyone, but mostly just stuff I copy from other people's work.

I know there's a SendMessage API call that helps one window communicate with another. My thought is that it can be used in place of SendKeys. SendMessage identifies the particular window to send the message to, so unlike SendKeys, the target window doesn't have to be the active window. If it sends a string to the active control in the target window, it may prove to be a more reliable way to handle this.

[Ivan F Moala]

Yes, I would think you are right John ... that was what I looked @ a while ago.
It's been a while since I looked @ this ..... I know last I looked i invoked the
proper project then used



Application.VBE.CommandBars(1).FindControl(ID:=2578, recursive:=True).Execute


to invoke the password dialog.

Now to send a message to this dialog we needed it's handle.
To get it's handle we needed it's class name and Title (@ least one way to get it ... there are others)
ClassName = #32770 (Dialog)
Title = VBAProject Password

so if any one wants to look further ? :) (I have no time .... )

[Howard Kaikow]

Yes, I would think you are right John ... that was what I looked @ a while ago.
It's been a while since I looked @ this ..... I know last I looked i invoked the
proper project then used



Application.VBE.CommandBars(1).FindControl(ID:=2578, recursive:=True).Execute


to invoke the password dialog.

Now to send a message to this dialog we needed it's handle.
To get it's handle we needed it's class name and Title (@ least one way to get it ... there are others)
ClassName = #32770 (Dialog)
Title = VBAProject Password

so if any one wants to look further ? :) (I have no time .... )

not sure if sendmessage can be used instead of sendkeys.

e.g.. how would one send the alt, ctrl and shift keys?

[XL-Dennis]

With Windows Scripting Host and WMI we can use SendKey to control a program but I'm not initiated when it comes to SendMessage.

SHIFT + and CTRL ^ as well as ALT %

BTW, check out the following book about Windows Scripting Host:
Windows 2000 Scripting Guide
http://www.amazon.com/exec/obidos/ASIN/0735618674/qid=1112400375/sr=2-1/ref=pd_bbs_b_2_1/103-8186757-5407802

I would say that it's the best book written book on the subject.

[JonPeltier]

not sure if sendmessage can be used instead of sendkeys.

e.g.. how would one send the alt, ctrl and shift keys?
Probably I'm showing my ignorance, but here's what I'm speculating. SendMessage puts text or a message in another window. In most forms (not VBA userforms), each of the controls is its own window with a handle. So you would have to identify the message by its hWnd rather than by using Alt-Hotkey to activate the control.

[Howard Kaikow]

With Windows Scripting Host and WMI we can use SendKey to control a program but I'm not initiated when it comes to SendMessage.

SHIFT + and CTRL ^ as well as ALT %

BTW, check out the following book about Windows Scripting Host:
Windows 2000 Scripting Guide
http://www.amazon.com/exec/obidos/ASIN/0735618674/qid=1112400375/sr=2-1/ref=pd_bbs_b_2_1/103-8186757-5407802

I would say that it's the best book written book on the subject.

i was talking about sendmessage, there does not appear to be any way to use sendmessage to send ctrl, alt, or shift,


Probably I'm showing my ignorance, but here's what I'm speculating. SendMessage puts text or a message in another window. In most forms (not VBA userforms), each of the controls is its own window with a handle. So you would have to identify the message by its hWnd rather than by using Alt-Hotkey to activate the control.

yes, but getting the right window is the problem.
I think that I figured out how to get to the "Project Properties" window, but not yet how to get to the "Protection" window without SendKeys.

Anyway, I'm done with this topic for a at least a few weeks.

[Ivan F Moala]

There's no need to send those chr, as you would enum down to the Daiologs text handle (Class name: edit) How would you do this with the Dialog open ?? .... unsure ... maybe use a timer (Windows API system timer) to initaiate the enumeration ....

Again, I haven't really looked @ it .. this is just top of the head thinking......