You are visitor number ????? since 30 April 2005.
Go to Howard Kaikow's home page

Date: 2 May 2007(Modification of 30 March 2006 version)
From: Howard Kaikow <>
Subject: Setting VBA Project Password

Note: This document should be printed using landscape mode.

Change History

This document describes how to set a VBA project password in code. I have chosen to use Visual Basic 6, but the code should work, with minor changes, in the Microsoft Office applications. I chose to apply the techniques to only Access, Excel, PowerPoint and Word.

Usually, this problem is attacked by using SendKeys. The purpose of this document is to demonstrate how to do the deed without using SendKeys.

A valuable side-effect of this solution is that it demonstrates techniques that could be used to avoid using SendKeys with other dialogs.

Earlier versions of the code were run with Office 97, Office 2000, Office XP, and Office 2003.

Note: The code for Access does not work with Access 97. I have noted which line of code does not work with Access 97 in the comments in the code.

The following describes what you need to do to replicate my approach assuming you are using Visual Basic 6. It should not be difficult to adapt this description to run the code from within Office.

Note: This example was developed using Visual Basic 6, however, if converted to VBA, the code will not work with Office 97.

  1. Create a new Standard EXE project.
  2. Add a code module.
  3. Include five command buttons on the Form. I chose to use the followng Names and Captions:
  4. Add project references for the Office object library and the VBA Extensibilty 5.3 library. In Office 97, use a reference to the VBA Extensibility library instead of a reference to the VBA Extensibility 5.3 library.
  5. Insert the following code in the code module:
    ' Author:Howard Kaikow
    ' URL:
    ' Email address:
    ' Date: April 2005
    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
  6. Insert the following code in the Form:
    ' Author:Howard Kaikow
    ' URL:
    ' Email address:
    ' Date: April 2005
    Option Explicit
        ' API constants
        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 HWND_TOPMOST As Long = -1
        Private Const SWP_NOACTIVATE As Long = &H10&
        Private Const SWP_NOMOVE As Long = &H2&
        Private Const SWP_NOSIZE As Long = &H1&
        Private Const SWP_SHOWWINDOW As Long = &H40&
        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 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
        Private Declare Sub SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, _
            ByVal x As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long)
    Private Sub Form_Activate()
        ' It is necessary to force Form to be topmost
        SetWindowPos Me.hWnd, HWND_TOPMOST, 0, 0, 0, 0, _
    End Sub
    Private Sub btnByeBye_Click()
        Unload Me
    End Sub
    Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
        If UnloadMode = vbFormControlMenu Then
            Cancel = 1
            MsgBox "Please use the " & btnByeBye.Caption & " button to exit.", vbInformation + vbOKOnly, _
                "Close button cannot be used to exit"
            Cancel = 0
        End If
    End Sub
    Private Function GetPath(strStartPath As String, strType As String, strProject As String) As String
        ' GetPath returns file path to be saved
        ' strStartPath: Aw, shucks, you can figure this out yourself
        ' strType: File type for saved file
        ' strProject: Project name
        Dim i As Long
        Dim strPath As String
        Dim strProjectStart As String
        strProjectStart = strProject
        strPath = strStartPath & "\" & strProjectStart & "." & strType
        i = -1
        While Len(Dir(strPath)) <> 0
            i = i + 1
            strProjectStart = strProject & Format(i)
            strPath = strStartPath & "\" & strProjectStart & "." & strType
        GetPath = strPath
    End Function
    Private Function GetPassword() As String
        ' Set password
        GetPassword = "my"
    End Function
    Private Sub SetPassword(proj As VBProject, strPassword As String)
    ' Author:Howard Kaikow
    ' URL:
    ' Email address:
    ' Date: April 2005
        ' spy++ was used to find the 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&
        Dim ctrl As Office.CommandBarControl
        Dim hWnd As Long
        Dim hWndLockProject As Long
        Dim hWndPassword As Long
        Dim hWndConfirmPassword As Long
        Dim hWndOK As Long
        Dim hWndSysTabControl32 As Long
        Dim strCaption As String
        With proj
            strCaption = .Name & " - Project Properties"
            With .VBE
                ' Find Project Properties dialog
                Set ctrl = .CommandBars.FindControl(ID:=2578)
                ' Display Project Properties dialog
                Set ctrl = Nothing
            End With
        End With
        ' Get hWnd for Project Properties dialog
        hWndProjectProperties = FindWindow(vbNullString, strCaption)
        If hWndProjectProperties = 0 Then
            Exit Sub
        End If
        ' 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)
        ' 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&
    End Sub
  7. For each application you wish to use, include the appropriate sub in the code for the Form and include references to the needed libraries for Access, Excel, PowerPoint, and Word.
    Private Sub btnCreatePowerPointPresentation_Click()
        Const strProject As String = "HKNewProject"
        Const strType As String = "ppt"
        Dim appPowerPoint As PowerPoint.Application
        Dim pptPowerPoint As PowerPoint.Presentation
        Dim strStartPath As String
        btnCreatePowerPointPresentation.Enabled = False
        Set appPowerPoint = New PowerPoint.Application
        With appPowerPoint
            strStartPath = App.Path
            Set pptPowerPoint = .Presentations.Add
            With pptPowerPoint
                .VBProject.Name = strProject
                SetPassword .VBProject, GetPassword()
                .SaveAs FileName:=GetPath(strStartPath, strType, strProject)
            End With
        End With
        Set appPowerPoint = Nothing
        Set pptPowerPoint = Nothing
        btnCreatePowerPointPresentation.Visible = False
    End Sub
    Private Sub btnCreateAccessDatabase_Click()
        Const strProject As String = "HKNewProject"
        Const strType As String = "mdb"
        Dim appAccess As Access.Application
        Dim strStartPath As String
        btnCreateAccessDatabase.Enabled = False
        strStartPath = App.Path
        Set appAccess = New Access.Application
        With appAccess
            .NewCurrentDatabase GetPath(strStartPath, strType, strProject)
            If .GetOption("Project Name") <> strProject Then
                .SetOption "Project Name", strProject
            End If
            ' The following does not compile in Access 97
            SetPassword .VBE.VBProjects(strProject), GetPassword()
        End With
        Set appAccess = Nothing
        btnCreateAccessDatabase.Visible = False
    End Sub
    Private Sub btnCreateWordTemplate_Click()
        Const strProject As String = "HKNewProject"
        Const strType As String = "dot"
        Dim appWord As Word.Application
        Dim docWord As Word.Document
        Dim strStartPath As String
        btnCreateWordTemplate.Enabled = False
        Set appWord = New Word.Application
        With appWord
    '        strStartPath = .Options.DefaultFilePath(wdUserTemplatesPath)
            strStartPath = App.Path
            Set docWord = .Documents.Add(NewTemplate:=True)
            With docWord
                .VBProject.Name = strProject
                SetPassword .VBProject, GetPassword()
                .SaveAs GetPath(strStartPath, strType, strProject), addtorecentfiles:=False
            End With
        End With
        Set appWord = Nothing
        Set docWord = Nothing
        btnCreateWordTemplate.Visible = False
    End Sub
    Private Sub btnCreateExcelWorkbook_Click()
        Const strProject As String = "HKNewProject"
        Const strType As String = "xls"
        Dim appExcel As Excel.Application
        Dim strStartPath As String
        Dim wbkExcel As Excel.Workbook
        btnCreateExcelWorkbook.Enabled = False
        Set appExcel = New Excel.Application
        With appExcel
    '        strStartPath = .DefaultFilePath
            strStartPath = App.Path
            Set wbkExcel = .Workbooks.Add()
            With wbkExcel
                .VBProject.Name = strProject
                SetPassword .VBProject, GetPassword()
                .SaveAs FileName:=GetPath(strStartPath, strType, strProject), addtomru:=False
            End With
        End With
        Set appExcel = Nothing
        Set wbkExcel = Nothing
        btnCreateExcelWorkbook.Visible = False
    End Sub
  8. Running the program

    I chose to use the password "my", which is set in the GetPassword function.

    I chose to have all files created in the directory in which the program runs.

    When you click on a button to run the code for a particular Office application, the button will be disabled and will vanish when that particular code is completed