In case anyone's interested.
The following is the code I ended up with.
I've run the code using Word 97, Word 2000, Word 2002 and Word 2003.
I used a VB 6 Form. Code might work in a Word VBA Userform, but I have no
interest in running such code from within Word.
The code will create a template in Word's default template directory.
The password is "my".
-----------------------------
3 References are required:
Office object Library
Word object Library
VBA for EXtensibity 5.3 (or equivalent in Word 97)
I expect to post versions of this code for at least Excel and Word at my web
site
Put the following in a code module:
Option Explicit
Public hWndProjectProperties As Long
Public Function EnumChildProc(ByVal hWnd As Long, ByVal lParam As Long) As
Long
hWndProjectProperties = hWnd
' Do not recurse
EnumChildProc = 0
End Function
Put the following in a VB 6 Form with 2 command buttons, as indicated in the
code:
Option Explicit
' Constants for SendMessage messages
Private Const BM_CLICK As Long = &HF5&
Private Const BM_SETCHECK As Long = &HF1&
Private Const BST_CHECKED As Long = &H1&
Private Const EM_REPLACESEL As Long = &HC2&
Private Const KEYEVENTF_EXTENDEDKEY As Long = &H1&
Private Const KEYEVENTF_KEYUP As Long = &H2&
' Needed if dialog is to be minimized in code below
'Private Const SW_SHOWMINIMIZED As Long = 2
Private Const TCM_SETCURFOCUS As Long = &H1330&
' API functions and subs
Private Declare Function EnumChildWindows Lib "user32" _
(ByVal hWndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As
Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetDlgItem Lib "user32.dll" _
(ByVal hDlg As Long, ByVal nIDDlgItem As Long) As Long
Private Declare Sub keybd_event Lib "user32.dll" _
(ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long,
ByVal dwExtraInfo As Long)
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long,
lParam As Any) As Long
Private Declare Function SetFocusAPI Lib "user32" Alias "SetFocus" _
(ByVal hWnd As Long) As Long
' Needed if dialog is to be minimized
'Private Declare Function ShowWindow Lib "user32" _
' (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function VkKeyScan Lib "user32" Alias "VkKeyScanA" _
(ByVal cChar As Byte) As Integer
Private Sub btnByeBye_Click()
Unload Me
End Sub
Private Sub GetPassword(strPassword As String)
' Set password
strPassword = "my"
End Sub
Private Sub KeyBoardSendString(strToSend As String)
' This sub may not handle all character codes correctly
Dim i As Long
Dim VirtualKey As Integer
For i = 1 To Len(strToSend)
VirtualKey = VkKeyScan(Asc(Mid$(strToSend, i, 1))) And &HFF
keybd_event VirtualKey, 0, KEYEVENTF_EXTENDEDKEY, 0 ' key down
keybd_event VirtualKey, 0, KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP,
0 ' key up
Next i
End Sub
Private Sub btnCreateTemplate_Click()
' spy++ was used to get Control IDs in Project Properties dialog
Const ControlIDConfirmPassword As Long = &H1556&
Const ControlIDLockProject As Long = &H1557&
Const ControlIDOK As Long = &H1&
Const ControlIDPassword As Long = &H1555&
Const ControlIDSysTabControl32 As Long = &H3020&
Const strProject As String = "HKNewTemplate"
Dim ctrl As Office.CommandBarControl
Dim appWord As Word.Application
Dim docWord As Word.Document
Dim hWndLockProject As Long
Dim hWndPassword As Long
Dim hWndConfirmPassword As Long
Dim hWndOK As Long
Dim hWndSysTabControl32 As Long
Dim strCaption As String
Dim strNewTemplate As String
Dim strPassword As String
Dim strPath As String
Set appWord = New Word.Application
With appWord
.Visible = False
.ScreenUpdating = False
.WindowState = wdWindowStateMinimize
strPath = .Options.DefaultFilePath(wdUserTemplatesPath) &
.PathSeparator
strNewTemplate = strPath & strProject & ".dot"
Set docWord = .Documents.Add(NewTemplate:=True)
With docWord
With .VBProject
' Rename template project
.Name = "HowardKaikowTest"
With .VBE
' Find Project Properties dialog
Set ctrl = .CommandBars.FindControl(ID:=2578)
' Displat Project Properties dialog
ctrl.Execute
Set ctrl = Nothing
End With
strCaption = .Name & " - Project Properties"
End With
' Get hWnd for Project Properties dialog
hWndProjectProperties = FindWindow(vbNullString, strCaption)
If hWndProjectProperties = 0 Then
Exit Sub
End If
GetPassword strPassword
' Get hWnd for OK button in Project Properties dialog
hWndOK = GetDlgItem(hWndProjectProperties, ControlIDOK)
' Get hWnd for Tab Control in Project Properties dialog
hWndSysTabControl32 = GetDlgItem(hWndProjectProperties,
ControlIDSysTabControl32)
'Move to Protection tab
SendMessage hWndSysTabControl32, TCM_SETCURFOCUS, 1, ByVal 0&
' Must reset hWndProjectProperties probably because tab changed.
EnumChildWindows ByVal hWndProjectProperties, AddressOf
EnumChildProc, ByVal 0
' Get hWnd for Password Edit control in Project Properties
dialog
hWndPassword = GetDlgItem(hWndProjectProperties,
ControlIDPassword)
' Get hWnd for Confirm Password Edit control in Project
Properties dialog
hWndConfirmPassword = GetDlgItem(hWndProjectProperties,
ControlIDConfirmPassword)
' Get hWnd for Lock Project checkbox control in Project
Properties dialog
hWndLockProject = GetDlgItem(hWndProjectProperties,
ControlIDLockProject)
' Minimize Project Properties dialog
' May cause problems if done before showing Protection tab
' Anyway, causes problem in Word 97, Word 2000
' Needed if dialog is to be minimized
'ShowWindow hWndProjectProperties, SW_SHOWMINIMIZED
' Lock project for &viewing
SendMessage hWndLockProject, BM_SETCHECK, BST_CHECKED, 0
' &Password
SendMessage hWndPassword, EM_REPLACESEL, vbTrue, ByVal
strPassword
' &Confirm password
SendMessage hWndConfirmPassword, EM_REPLACESEL, vbTrue, ByVal
strPassword
'OK button
SetFocusAPI hWndOK
SendMessage hWndOK, BM_CLICK, 0, 0
On Error Resume Next
Kill strNewTemplate
On Error GoTo 0
.SaveAs strNewTemplate, addtorecentfiles:=False
.Close
End With
.ScreenUpdating = True
.Quit
End With
Set appWord = Nothing
Set docWord = Nothing
btnCreateTemplate.Visible = False
End Sub