How to password protect a folder in Microsoft Office 2003

Office 2003 has no facility to password protect folders. You can individually password protect the files in the folders; and through the operating system restrict access to the folders.

If your Buffalo drive is a NAS drive in addition you can probably restrict who accesses that drive also, through the NAS file sharing.

To protect the files in the folder, run the following macro on the folder and don't forget the password!!! or you won't be able to open them again! http://www.gmayor.com/installing_macro.htm

Public Sub PasswordAll()

Dim strFileName As String

Dim sPassword As String

Dim bPassword As String

Dim strPath As String

Dim oDoc As Document

Dim bBack As Boolean

Dim Response As Long

Dim fDialog As FileDialog

Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)

With fDialog

    .Title = "Select the folder containing the documents to protect and click OK"

    .AllowMultiSelect = False

    .InitialView = msoFileDialogViewList

    If .Show <> -1 Then

        MsgBox "Cancelled By User", , "Add Password To All"

        Exit Sub

    End If

    strPath = fDialog.SelectedItems.Item(1)

    If Right(strPath, 1) <> "" Then strPath = strPath + ""

End With

OpenPass:

sPassword = InputBox("Enter the Password", "Password to Open")

bPassword = InputBox("Re-enter Password", "Password to Open")

If sPassword <> bPassword Then

    MsgBox "The password and check do not match", _

    vbCritical, "Password Error!"

    GoTo OpenPass

End If

On Error Resume Next

Documents.Close SaveChanges:=wdPromptToSaveChanges

bBack = Options.CreateBackup

Options.CreateBackup = False

strFileName = Dir$(strPath & "*.doc")

While strFileName <> ""

        WordBasic.DisableAutoMacros 1

        Set oDoc = Documents.Open(strPath & strFileName)

        With oDoc

        .Password = sPassword

        .SaveAs .FullName, AddtoRecentFiles:=False

        .Close SaveChanges:=wdDoNotSaveChanges

    End With

    strFileName = Dir$()

    WordBasic.DisableAutoMacros 0

Wend

Options.CreateBackup = bBack

End Sub