複数ファイルパスワード操作(Word)

以前、Excelで複数のファイルに共通のパスワードをセットしたり解除したりするマクロを紹介しました。
You Look Too Cool » 複数ファイルパスワード操作
それのWord版を作ってみました。Word2007で確認しました。

Sub 複数ファイルパスワード操作()
'フォルダ内の共通のパスワードがセットされた文書を連続して開き、解除して上書き保存。
'逆にフォルダ内の文書を連続して開き、共通のパスワードをセットして上書き保存。
Dim onoff As Long
Dim mypw, pwopen, pwclose, mypath, myfn As String
'操作を選択
onoff = MsgBox("パスワード解除ならば「はい」、セットならば「いいえ」", vbYesNo)
If onoff = vbCancel Then
Exit Sub
End If
'パスワードをセット
mypw = InputBox("パスワードを入力。", "パスワード")
If onoff = vbYes Then
pwopen = mypw
pwclose = ""
ElseIf onoff = vbNo Then
pwopen = ""
pwclose = mypw
Else
Exit Sub
End If
'フォルダの選択
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "フォルダを選択"
.AllowMultiSelect = False
If .Show = -1 Then
mypath = .SelectedItems(1) & ""
Else
Exit Sub
End If
End With
'ファイルの取得と実行
myfn = Dir(mypath & "\*.doc*", vbNormal)
Do Until myfn = ""
'開く
Documents.Open FileName:=mypath & myfn, PasswordDocument:=pwopen
'文末に改行を挿入し削除(何らかの変更がないと上書き保存できない)
Selection.EndKey Unit:=wdStory
Selection.TypeParagraph
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=1
'上書き保存
ActiveDocument.SaveAs FileName:=ActiveDocument.FullName, Password:=pwclose, WritePassword:=""
ActiveWindow.Close
myfn = Dir
Loop
End Sub

途中に「文末に」というコメントを入れていますが、Wordの場合、文章に何らかの変更がないと上書きできないようなのです。それでやむを得ず文末に改行を挿入してそれを削除するという処理を入れています。

ファイルに直接、変更を加えるので、使うときはバックアップを取るなど、充分、注意してください。特にパスワードをセットする場合はパスワードを忘れないでください。