エクセルで複数ファイルに同一のパスワードをまとめて設定したいです

同一のフォルダにある複数のファイル（600個位）に同一の書き込みパスワードを設定したいのですが、まとめてやれる方法はないでしょうか？どうもそういうソフトウェアがありそうなことはわかったのですが、有料のものしか見つけられませんでした（会社のインターネットにブロックがかかっているせいかもしれません）。できればフリーソフトで手に入れたいのですが、何かよいものをご存知の方いらっしゃいますか？
もちろん、フリーソフト以外でもマクロやその他の方法でも何かいい方法があれば教えて欲しいです。
はじめは1個1個設定していたのですが、100個を越したあたりで吐き気がしてきて、もう少し楽な方法があるかもと思い探しております。お知恵を貸してください。

No.4 ベストアンサー 回答者： merlionXX 回答日時： 2009/02/06 10:34

No3のmerlionXXです。

よく考えたらもう100個も同一の書き込みパスワードを設定しているのですよね。
だったら、いまさらフォルダーを分けるのも大変でしょうから、同一であれば書き込みパスワードが設定されたBOOKがあってもOKのように変えてみました。
Const myPass = "pass"　の部分で　""　の中のpassをほんとのパスワードに換えて実行してみてください。

Sub TEST02()
Const myPass = "pass"
Application.ScreenUpdating = False '画面更新を停止
On Error GoTo line 'エラーの場合エラー処理へ飛ぶ
myfdr = ThisWorkbook.Path 'このBOOKのフォルダー名取得
fname = Dir(myfdr & "\*.xls") 'フォルダ内のExcelブックを検索
Do Until fname = Empty '全てを検索
If fname <> ThisWorkbook.Name Then 'ブック名がこのブックの名前でなければ
Set wb = Workbooks.Open(myfdr & "\" & fname, WriteResPassword:=myPass) 'そのブックを開き、wbとする。
Application.DisplayAlerts = False '警告停止
wb.SaveAs Filename:=fname, WriteResPassword:=myPass '書き込みパスワード設定
wb.Close '閉じる
Application.DisplayAlerts = True '警告停止解除
n = n + 1 'ブック数をカウント
End If
fname = Dir 'フォルダ内の次のExcelブックを検索
Loop '繰り返す
Application.ScreenUpdating = True '画面更新停止を解除
MsgBox n & "件のブックを処理しましました。", vbInformation, " （￣ー￣）v "
Exit Sub
line: 'エラー処理
Application.ScreenUpdating = True '安全策
Application.DisplayAlerts = True '安全策
MsgBox "予期せぬ事由により" & n + 1 & "件目で失敗し、中断しました。", vbCritical, " Σ（￣ロ￣lll) "
End Sub

この回答へのお礼

できました！！！
感謝、感謝、感謝です。
助かりました。あんなに苦労してたのに15分くらいで終わりました。
今回はコピーしてすぐに使ってしまいましたが、後でじっくりコードを見て勉強します。回答ありがとうございました。

お礼日時：2009/02/06 13:53

No.3 回答者： merlionXX 回答日時： 2009/02/06 10:14

ためしに作って見ました。

このマクロを実装したブックを対象とするフォルダー内に保存してから実行してみてください。ただし既に読取専用に設定されたBOOKがあると失敗しますのでフォルダー内は設定されていないブックだけにしてください。

Sub TEST01()
Application.ScreenUpdating = False '画面更新を停止
On Error GoTo line 'エラーの場合エラー処理へ飛ぶ
myfdr = ThisWorkbook.Path 'このBOOKのフォルダー名取得
fname = Dir(myfdr & "\*.xls") 'フォルダ内のExcelブックを検索
Do Until fname = Empty '全てを検索
If fname <> ThisWorkbook.Name Then 'ブック名がこのブックの名前でなければ
Set wb = Workbooks.Open(myfdr & "\" & fname) 'そのブックを開きwbとする。
Application.DisplayAlerts = False '警告停止
wb.SaveAs Filename:=fname, WriteResPassword:="pass" '書き込みパスワード設定
wb.Close '閉じる
Application.DisplayAlerts = True '警告停止解除
n = n + 1 'ブック数をカウント
End If
fname = Dir 'フォルダ内の次のExcelブックを検索
Loop '繰り返す
Application.ScreenUpdating = True '画面更新停止を解除
MsgBox n & "件のブックを処理しましました。", vbInformation, " （￣ー￣）v "
Exit Sub
line: 'エラー処理
Application.ScreenUpdating = True '安全策
Application.DisplayAlerts = True '安全策
MsgBox "予期せぬ事由により" & n + 1 & "件目で失敗し、中断しました。", vbCritical, " Σ（￣ロ￣lll) "
End Sub

No.2 回答者： mu2011 回答日時： 2009/02/06 09:48

安直ですが、圧縮ツール（仮にＺＩＰ）でパスワード設定する方法は如何でしょうか。

仮にＷｉｎ－ＸＰなら右クリックメニューの「送る」から圧縮（ＺＩＰ）フォルダ作成後、パスワード追加（同一パスワードになる）で一括設定が可能です。

この回答へのお礼

エクセルでやらないといけないもので。でも、回答ありがとうございます

お礼日時：2009/02/06 13:50

No.1 回答者： noname#111860 回答日時： 2009/02/06 08:59

自分だったら、作成しても公開しないと思います。

マクロの記録を使って、書込みパスワードを設定してみてください。
後は、Dir関数などで、指定フォルダにあるファイルに対し、
繰返すだけです。

＃１日～２日で作成できる単純なマクロなので

この回答へのお礼

パスワードの入力もマクロでできるとは思っていなかったです。本当にいろいろなことができるのですね。
今回は他の人のコードを使ってしまいましたが、もっと勉強しようと思います。ありがとうございました。

お礼日時：2009/02/06 13:55