1つのExcleファイルに自動的にパスワードを設定する関数 JK_FILE_PASS

AccessもしくはExcelのモジュールに以下の関数をコピーして、必要箇所で呼び出します。Accessで実装する場合には、Microsoft Excel Object Library などの参照設定の設定が必要な場合があります。
Public Function JK_FILE_PASS(file_name As String, file_pass As String)
''file_name のエクセルファイルを file_pass  のパスワードをつける関数です。
''file_nameは、拡張子を含む完全パスを指定してください。
''(相対パスのテストはしていません)
''すでにfile_pass以外のパスワードがつけられている時は処理を停止します。

On Error GoTo Err_JK_FILE_PASS

   Dim oApp As Object
   Dim file_name2 As String    '一時的なファイル名

   If file_name Like "*.XLS" Then
       file_name2 = Mid(file_name, 1, Len(file_name) - 4) & "_JK_BK.XLS" '一時 ファイル名を作成
   Else
       MsgBox "エクセルファイルではありません。"
       Exit Function
   End If

   Set oApp = CreateObject("Excel.Application")
   oApp.Visible = True
   'Only XL 97 supports UserControl Property
   On Error Resume Next
   oApp.UserControl = True
   oApp.Workbooks.Open FileName:=file_name, UpdateLinks:=2, Password:=file_pass
   oApp.ActiveWorkbook.SaveAs FileName:=file_name2, FileFormat:=xlNormal, Password:=file_pass

   'MsgBox Dir(file_name2)
   If Dir(file_name2) <> "" Then   '一時ファイルが作られたとき(正常な場合だけファイルを置き換え)
       oApp.ActiveWorkbook.Close
       Kill file_name
       Name file_name2 As file_name
   End If

   oApp.Quit


Exit_JK_FILE_PASS:
   Exit Function

Err_JK_FILE_PASS:
   MsgBox Err.Description
   Resume Exit_JK_FILE_PASS

End Function

ディレクトリ下のExcleファイルをすべてパスワード設定する関数 JK_DIR_PASS

上記のJK_FILE_PASSを使ったディレクトリ丸ごとパスワード設定関数です。上記の関数も一緒にモジュールに追加してお使い下さい。
Public Function JK_DIR_PASS(dir_name As String, file_pass As String)

Dim file_name As String
Dim fN(9999)
Dim iC As Integer
Dim iCd As Integer
Dim i As Integer

file_name = Dir(dir_name & "\" & "\*.xls")    ' フォルダ名内の最初のエクセルファイル名を返します。
iC = 0
Do While file_name <> ""   ' ループを開始します。
   fN(iC) = dir_name & "\" & file_name
   file_name = Dir
   iC = iC + 1
Loop

For i = 0 To iC - 1
   JK_FILE_PASS (fN(i)), (file_pass)
Next i

Erase fN
End Function

サブディレクトリのファイル名まで取得してパスワードを設定する関数 JK_DIR_KAISOU_PASS

最大99階層のサブディレクトリまで下がってエクセルファイルにパスワード設置をします。かなり強引なやり方です。最後の JK_DIR_PASS より上の部分は、単に配列にディレクトリ名を追加して行っているので、その他の用途にもお使いになれると思います。 パスワード設定には、上記2つの関数が必要です。
Public Function JK_DIR_KAISOU_PASS(dir_name As String, file_pass As String)
On Error Resume Next  'ファイル名がどうしてもエラーになるときがあるので・・・・とりあえず
DoCmd.SetWarnings False

Dim dN(9999)
Dim iC As Integer
Dim iCd As Integer
Dim i As Integer
Dim dir_kaisou_name As String

dir_kaisou_name = Dir(dir_name & "\", vbDirectory)
iC = 0
Do While dir_kaisou_name <> ""
   If dir_kaisou_name <> ".."  Then
       If (GetAttr(dir_name & "\" & dir_kaisou_name) And vbDirectory) =  vbDirectory Then
           dN(iC) = dir_name & "\" & dir_kaisou_name
           'MsgBox dN(iC)
           iC = iC + 1
       End If
   End If
   dir_kaisou_name = Dir
Loop

Dim iC2 As Integer
Dim iC3 As Integer
Dim j As Integer
Dim iPre As Integer

iC2 = 0
iPre = 0

For j = 0 To 99     'ディレクトリの99階層まで下る

iC3 = iC
iC2 = iPre

   For i = iC2 To iC3 - 1

       If i = iC2 Then
           iPre = iC
       End If

       dir_kaisou_name = Dir(dN(i) & "\", vbDirectory)

       Do While dir_kaisou_name <> ""
           If Len(dN(i)) > 0 And Right(dN(i), 2) <> "\." And dir_kaisou_name <> ".." _
           And dir_kaisou_name <> "." Then
               If (GetAttr(dN(i) & "\" & dir_kaisou_name) And vbDirectory) = vbDirectory Then
                   dN(iC) = dN(i) & "\" & dir_kaisou_name
                   'If j > 3 Then
                   '    MsgBox dN(iC)
                   'End If
                   iC = iC + 1
               End If
           End If
           dir_kaisou_name = Dir
       Loop

   Next i

Next j

'ここからエクセルファイルパスワードをつける

For i = 0 To iC - 1
   JK_DIR_PASS (dN(i)), (file_pass)
Next i

End Function