Vba, mot de passe

Bonjour,
Je voudrais savoir si quelqu'un connaissait la syntaxe pour faire qu'une fonctionnalité programmée au préalable, necessite un mot de passe pour l'activation,
Merci de vos réponses.
Ps: voici le code de ma fonctionnalité:

Option Explicit

Dim Chemin As String
Sub liste_fichiersActionCo2010()
Dim ScanFic As Office.FileSearch
Dim NomFic As Variant
Dim exten As String
Dim Nbr, i As Long

Call parcourir
exten = InputBox("Saisissez ici l'extension souhaitée pour la recherche. Par ex : xls pour excel, doc pour word, ppt pour powerpoint, pour tous fichiers tapez *.*", "Extension de fichier")
If exten = "" Then
MsgBox "Saisie obligatoire"
Exit Sub
End If
Set ScanFic = Application.FileSearch
With ScanFic
.NewSearch
.LookIn = Chemin
.SearchSubFolders = True
.Filename = exten
.MatchTextExactly = True
.FileType = msoFileTypeAllFiles
Nbr = .Execute
i = 1
For Each NomFic In .FoundFiles
i = i + 1

Sheets("ActionCoContrat2010").Cells(i + 6, 1).Value = i - 1
Sheets("ActionCoContrat2010").Cells(i + 6, 2).Value = RetourneNomFichier(NomFic)
Sheets("ActionCoContrat2010").Cells(i + 6, 3).Hyperlinks.Add Anchor:=Sheets("ActionCoContrat2010").Cells(i + 6, 3), Address:=NomFic
Sheets("ActionCoContrat2010").Cells(i + 6, 4).Value = FileDateTime(NomFic)
Sheets("ActionCoContrat2010").Cells(i + 6, 5).Value = Right(NomFic, 4)

Next
End With

End Sub

Sub parcourir()
Dim objShell As Object, objFolder As Object, oFolderItem As Object
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)
On Error Resume Next
Set oFolderItem = objFolder.Items.Item
Chemin = oFolderItem.Path
End Sub

Function RetourneNomFichier(ByVal sChemin As String) As String
If InStr(sChemin, "\") = 0 Or Right(sChemin, 1) = "\" Then
RetourneNomFichier = ""
Exit Function
End If
RetourneNomFichier = Mid(sChemin, InStrRev(sChemin, "\") + 1)
End Function