Protect/Unprotect Excel/Word/Powerpoint Files At Once (Recursive Usage)
はじめに
このマクロは、このマクロとこのマクロの改訂版になります。内容が更新されておりますので、こちらの記事をご覧ください。今回は一括設定と一括解除をひとつのファイルにしています。こちらからダウンロードできます。
・動作は無保証です。
・エクセルで動くマクロです。
・シート上のボタンを押すだけで、フォルダ内のエクセル・ワード・パワポのファイルにパスワードを一括設定・解除することができます。
・説明の簡略化のためにエラー処理などはいっさい施していません。ご自分で実装なさってください。
・動作確認は、Windows 10 + Excel 2016、Windows 7 + Excel 2010でおこなっています。
・このマクロを保存するブックにはパスワードはかからないようになっていますので、このブックだけは手動でパスワードを設定してください。
・参照設定は、「Microsoft Scripting Runtime」「Microsoft Word 16.0 Object Library」「Microsoft Powerpoint 16.0 Object Library」に対して参照設定してください（Excel 2016の場合）。
これまでと変わったところ
・以前作成したマクロは、Dir関数とFileSystemObjectの両方を使っていましたが、今回のものはFileSystemObjectのみを使って作成することにチャレンジしました。
・以前のものは、単一のフォルダにしか対応していませんでした。しかし、今回のものは、マクロが自分自身を呼び出す再帰呼び出しというテクニックを使って、サブフォルダを含む複数フォルダのファイルに対応しています。
・より高級な（難しい）テクニックは再帰呼び出しですが、より重要なテクニックは、基本的なテクニックという意味でFileSystemObjectです。
パスワード一括設定マクロのソース
Option Explicit
'「ツール(T)」⇒「参照設定(R)...」から以下のライブラリにチェックを
'入れてください。
'「Microsoft Scripting Runtime」
'「Microsoft Word 16.0 Object Library」（バージョンの数字は可変）
'「Microsoft Powerpoint 16.0 Object Library」（バージョンの数字は可変）
'***パスワード一括設定マクロ***
Public Sub S_ProtectFiles_Main()
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
'パスワード設定用フォルダ取得
Dim TargetPath As String: TargetPath = F_GetTargetPath
If TargetPath = "" Then Exit Sub
'パスワード入力
Dim TargetPassword As Variant
TargetPassword = Application.InputBox _
("設定するパスワードを入力してください。", "パスワード入力")
If TargetPassword = False Then Exit Sub
'パスワード一括設定
Call S_ProtectFiles_Core(TargetPath, TargetPassword)
With Application
.DisplayAlerts = True
.ScreenUpdating = True
End With
MsgBox "パスワード一括設定終了", vbOKOnly + vbInformation, _
"パスワード一括設定マクロ"
End Sub
'***パスワード設定用フォルダ取得***
Private Function F_GetTargetPath() As String
'フォルダ取得
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "パスワードを設定したいフォルダ(サブフォルダを含む)を" & _
"指定してください。"
.ButtonName = "フォルダ指定(&S)"
.InitialView = msoFileDialogViewList
.AllowMultiSelect = False
Select Case .Show
Case True
Dim Folder As String
Folder = .SelectedItems(1)
Case False
MsgBox "キャンセルが押されたので終了します。", _
vbOKOnly + vbExclamation, "プログラムの終了"
F_GetTargetPath = ""
Exit Function
End Select
End With
'フォルダ確認
Dim ans As VbMsgBoxResult
ans = MsgBox("パスワードを設定するフォルダ(サブフォルダを含む)は" _
& Folder & "ですね。", vbYesNo + vbInformation, "フォルダ確認")
Select Case ans
Case vbYes
F_GetTargetPath = Folder
Case vbNo
MsgBox "「いいえ」が押されたので終了します。", _
vbOKOnly + vbExclamation, "プログラムの終了"
F_GetTargetPath = ""
End Select
End Function
'***パスワード一括設定***
Private Sub S_ProtectFiles_Core _
(ByVal TargetPath As String, ByVal TargetPassword As String)
'対象フォルダの特定
Dim FSO As Object: Set FSO = CreateObject("Scripting.FileSystemObject")
Dim TargetFolder As Object: Set TargetFolder = FSO.GetFolder(TargetPath)
'ワードオブジェクトの取得
Dim wdApp As Object: Set wdApp = CreateObject("Word.Application")
With wdApp
.DisplayAlerts = wdAlertsNone
.Visible = False
End With
'パワポオブジェクトの取得
Dim ppApp As Object
Set ppApp = CreateObject("Powerpoint.Application")
ppApp.DisplayAlerts = ppAlertsNone
'パスワード一括設定
Dim File As Object
For Each File In TargetFolder.Files
'拡張子取得
Dim Extension As String
Extension = LCase(FSO.GetExtensionName(File.Name))
'拡張子による分岐
Dim buf As Object
Select Case Extension
'エクセルファイルの処理
Case "xls", "xlsx", "xlsm"
Set buf = Workbooks.Open(Filename:=TargetPath & "\" & File.Name)
With buf
If ThisWorkbook.FullName <> .FullName And _
Not LCase(.Name) Like "personal.xls?" Then
.SaveAs Filename:=.FullName, Password:=TargetPassword
.Close
End If
End With
Set buf = Nothing
'ワードファイルの処理
Case "doc", "docx", "docm"
Set buf = wdApp.Documents.Open(Filename:=TargetPath & "\" & File.Name)
With buf
.Saved = False
.SaveAs2 Filename:=.FullName, Password:=TargetPassword
.Close
End With
Set buf = Nothing
'パワポファイルの処理
Case "ppt", "pptx", "pptm"
Set buf = ppApp.Presentations.Open(Filename:=TargetPath & "\" & _
File.Name, WithWindow:=msoFalse)
With buf
.Password = TargetPassword
.Save
.Close
End With
Set buf = Nothing
End Select
Next File
'サブフォルダ取得（再帰呼び出し）
Dim Folder As Object
For Each Folder In TargetFolder.SubFolders
Call S_ProtectFiles_Core(Folder.Path, TargetPassword)
Next Folder
'オブジェクト変数の解放
wdApp.Quit
Set wdApp = Nothing
ppApp.Quit
Set ppApp = Nothing
Set TargetFolder = Nothing
Set FSO = Nothing
End Sub
重複があるかも知れませんが、この記事を読むだけで済むように気づいたことはすべて説明を加えます
パスワード一括設定マクロの解説
以下の解説は、ソースコードにつけたコメントに基づいて分割しておこないたいと思います。
マクロ高速化・自動化のためのプロパティ設定
With Application .ScreenUpdating = False .DisplayAlerts = False End With
よくある設定ですが、やはり効果は大きいといえます。今回のマクロは、次々とファイルを開きますので、画面がチラついたり、うっかりすると警告ダイアログが開く可能性がありますので、この設定は欠かせません。プロパティ・プロシージャを使ってこの設定をしたい方は、こちらのページが参考になります。
VBA マクロ高速化のために停止すべき3項目 – t-hom’s diary
パスワード設定用フォルダ取得
Dim TargetPath As String TargetPath = F_GetTargetPath If TargetPath = "" Then Exit Sub
1行目と2行目は次のようにまとめて書くこともできます。
Dim TargetPath As String: TargetPath = F_GetTargetPath
なぜこのような書き方をする人がいるのかといえば、他の言語では変数の宣言・データ型の定義と変数への初期値の代入は1つの式でやるのが当たり前だからです。例えば、VB.NETでは
Dim num As Integer = 0
という書式になります。
VBAは、VB.NETの前身のVB6.0準拠の言語なので、VB.NETと同じ書き方はできません。ですので、コロンで1行にまとめる方法をご紹介したわけです。
もちろん、コロンで2文を1文にまとめられるのは、このような場合だけではありませんが、ここでは省略します。
ここで紹介したからといって、2文を1文にまとめなければならないわけではありません。しかし、こういう書き方もあるということを知っておいて損はないと思います。
実際のフォルダ取得は、「F_GetTargetPath」という関数（ファンクション・プロシージャ）を使って処理して、フォルダ名を取得しています。
パスワード入力
Dim TargetPassword As Variant
TargetPassword = Application.InputBox _
("解除するパスワードを入力してください。", "パスワード入力")
If TargetPassword = False Then Exit Sub
このパスワードを代入する変数「TargetPassword」はVariant型で宣言していますが、これはInputBoxメソッドの戻り値が正常に入力されたときはString型、キャンセルボタンを押されたときはBoolean型（False)となり、マクロ作成時点では戻り値のデータ型がString型になるか、Boolean型になるかわからないからです。
したがって、2行目は戻り値がFalseだったらマクロを終了するという意味になります。
パスワード一括設定
Call S_ProtectFiles_Core(TargetPath, TargetPassword)
ここではサブルーチンを呼び出しています。引数として、「TargetPath」「TargetPassword」を渡して、実際のパスワード一括設定の処理はサブルーチンの中でおこなっています。こうやって処理を分割することによって、全体の流れがつかみやすくなります。これをご覧になっているあなたも、ぜひサブルーチンを活用して処理を分割するようにしてください。
ここでは「Call」を使ってサブプロシージャを呼び出していますが、「Call」を使わない場合は、
S_ProtectFiles_Core TargetPath, TargetPassword
とします。「Call」をはずすだけではなく、カッコもはずします。
マクロ高速化・自動化のためのプロパティ設定の解除
With Application .DisplayAlerts = True .ScreenUpdating = True End With
このプロパティ設定は、2つの設定に「False」を代入することでおこなわれたわけですが、解除（設定の無効化）は2つの設定に「True」を代入することでおこなわれます。
最後に処理の終了を示すMsgBoxを表示して終わります。
パスワード設定用フォルダ取得サブルーチンの解説
フォルダ取得
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "パスワードを設定したいフォルダ(サブフォルダを含む)を" & _
"指定してください。"
.ButtonName = "フォルダ指定(&S)"
.InitialView = msoFileDialogViewList
.AllowMultiSelect = False
Select Case .Show
Case True
Dim Folder As String
Folder = .SelectedItems(1)
Case False
MsgBox "キャンセルが押されたので終了します。", _
vbOKOnly + vbExclamation, "プログラムの終了"
F_GetTargetPath = ""
Exit Function
End Select
End With
ここでダイアログを表示・操作してファイル名を取得しています。
「Application.FileDialog」プロパティは本来ファイルを取得するファイルダイアログオブジェクトを返しますが、「fileDialogType」パラメータに「MsoFileDialogType」列挙体の中から「msoFileDialogFolderPicker」を指定することで、フォルダを取得することも可能です。
この文に出てくる「プロパティ」「ダイアログ」「オブジェクト」「パラメータ」「列挙体」などの言葉が理解できなくても、この文をコピペすればフォルダを取得することは可能です。
ですが、もうワンステップ上に行きたいという方は、上に挙げた「プロパティ」「ダイアログ」「オブジェクト」「パラメータ」「列挙体」という用語についてググることをおススメします。これらの用語が理解できたほうがプログラムの意味もわかりますし、何より楽しくなります。
ググって調べることができる方には、「FileDialog」「fileDialogType」「MsoFileDialogType」「msoFileDialogFolderPicker」についてオブジェクトブラウザで調べることをおススメします。
オブジェクトブラウザを使えば正確な知識が手に入り、さらにそこからヘルプに飛ぶこともできて、調べながら書いているときの納得感は大幅に上がります。
例えば、「MsgBox」の戻り値が「Long型」だと平易だけれども正確でない知識をお持ちの方は、オブジェクトブラウザを使えば、「MsgBox」の戻り値の型は「VbMsgBoxResult型」であるという平易ではないけれども正確な知識を得ることができます。
いつも使っている「Visual Basic Editor」上で「MsgBox」を選択し「Shift + F2」を押すとオブジェクトブラウザが表示されます。そこにはちゃんと「VbMsgBoxResult」型であることが表示されています。
話がそれたので元に戻しますと、注意すべき点が2点あります。
1点目は「.ButtonName」プロパティの挙動です。2016では、最初からアクションボタンの表示名が「フォルダ指定(S)」となっていますが、2010では最初は「開く(0)」となっていて、フォルダを選択してはじめて「フォルダ指定(S)」と変化する点です。本マクロの動作に影響を与えることはありませんが、はじめて見るとドキッとします。
2点目は、ここでは出てきていませんが、「.InitialFileName」の挙動です。これは初期表示するファイル名を指定するためのプロパティですが、ファイル名のないパスのみを指定した場合、たとえば「C:\Users\amacoda\Documents\Excel Files\」としたときは、ファイル名を指定することなく（ファイル名欄は空欄のままで）、つねに指定したフォルダを開きます。
続いて、「.Show」プロパティですが、ダイアログ ボックスを表示し、「フォルダ指定」ボタン（-1）が押されたのか、キャンセルボタン（0）が押されたのかを示す整数型（Integer）の値を返します。
ここでは、平易だけど正確ではないコードをあえて書いています。「.Show」プロパティが返すのは整数型の値なので、あくまで「-1」「0」というリテラル値です。「True」「False」ではありません。
しかし、イミディエイトウィンドウで「?cint(true)」と入力しエンタを押すと「-1」が返ってきます。同様に「?cint(false)」と入力しエンタを押すと「0」が返ってきます。 そして、私たちは「Show -> True = 見える」「Show -> False = 見えない」というのをなんとなく知っています。この無意識の知恵を利用して、「.Show」プロパティの返り値を「True」「False」で表しています。
「.Show」の戻り値は「Select Case」文を使って分岐させています。普通は「If」分を使うのですが、「True」「False」という返り値を強調したい（わかりやすくしたい）ために、あえて「Select Case」文を使っています。
「True」の場合に、Folderという変数を使用する直前に宣言しています。これについて詳しい説明がなされてる下記のようなサイトがありますので、ぜひご参照ください。
VBA ローカル変数は使用する直前で宣言する – t-hom’s diary
「False」の場合は、ダイアログを表示しない、すなわちフォルダを選択しない、ということなので、このマクロ全体を終了するためのMsgBoxの表示をして、終了の準備をしています。
パスワード一括設定サブルーチンの解説
対象フォルダの特定
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
Dim TargetFolder As Object
Set TargetFolder = FSO.GetFolder(TargetPath)
FileSystemObjectオブジェクトを宣言・取得し、それを利用して対象フォルダを宣言・取得しています。
まず、FileSystemObjectオブジェクトを格納する変数をObject型という汎用のデータ型で宣言し、「Set」ステートメントで「CreateObject」関数を用いて「FSO」という変数にFileSystemObjectオブジェクトを格納しています。
次に、「TargetFolder」という変数にFileSystemObjectオブジェクトのGetFolderメソッドを利用して、対象フォルダを示す「TargetPath」を格納しています。
最初に「参照設定」をしておいたので、
Dim FSO As New Scripting.FileSystemObject
という書き方も可能ですが、Microsoftがこの書き方を推奨しないということなので、使っていません。
VB 6.0 ユーザーのためのVB.NET 移行ガイド – Dim x As New MyClass
ちなみにここに挙げた書き方を「実行時バインディング」といいます。
ワードオブジェクトの取得
Dim wdApp As Object
Set wdApp = CreateObject("Word.Application")
With wdApp
.DisplayAlerts = wdAlertsNone
.Visible = False
End With
上記のやり方と同じく「実行時バインディング」で変数「wdApp」にワードオブジェクトへの参照を格納しています。
次に、ワードの操作の自動化の設定をしています。これをやらないと、本マクロが途中で止まって、手動で操作しなくてなならなくなってしまいます。
「.DisplayAlerts」プロパティに「wdAlertsNone」を設定しています。これで警告メッセージが非表示になります。エクセルでは「False」でいいのですが、ワードでは「wdAlertsNone」です。ググらずにオブジェクトブラウザで調べることをおススメします。
ライブラリから「Word」を選択し、「DisplayAlerts」を検索すると、「WdAlertLevel」列挙体の中に「wdAlertsNone」がちゃんとあります。
その一方で、「.Visible」プロパティは、ワードオブジェクトの表示／非表示を切り替えるプロパティですが、こちらは「False」です。
パワポオブジェクトの取得
Dim ppApp As Object
Set ppApp = CreateObject("Powerpoint.Application")
ppApp.DisplayAlerts = ppAlertsNone
「実行時バインディング」で変数「ppApp」にパワポオブジェクトへの参照を代入しています。
操作の自動化の設定ですが、「.DisplayAlerts」プロパティに「ppAlertsNone」を代入しています。ワードと似ているので、これもオブジェクトブラウザで調べることをおススメします。
パワポの「Application.Visible」プロパティはパワポオブジェクトの表示・非表示に関するプロパティではありません、と以前書きましたがどうやらそれは間違いだったようです。次のサイト
Application.Visible プロパティ (PowerPoint) には「指定したオブジェクトまたは指定したオブジェクトに適用された書式設定を表示するかどうかを設定します。値の取得および設定が可能です。」とあります。
英語だと、「Returns or sets the visibility of the specified object or the formatting applied to the specified object. Read/Write.」です。日本語だけを読んで、勘違いしたようです。
.Visible = msoFalse
とすれば、パワポオブジェクトを非表示にすることはできるようですが、別のやり方を発見したので、ここではそのやり方はしません。
パスワード一括設定
Dim File As Object For Each File In TargetFolder.Files ～～～～～～～～～～ Next File
ここから本マクロの中心部分の解説です。
まずは、Fileという変数を用意します。この変数はこれから開くすべてのファイルを順番に代入する変数です。
「TargetFolder.Files」コレクションには対象フォルダのすべてのファイルを含みます。
すべてのファイルを順番に取り上げるために「For Each」文を利用しています。
拡張子取得
Dim Extension As String Extension = LCase(FSO.GetExtensionName(File.Name))
「GetExtensionName」メソッドの返り値である拡張子名を、LCase関数に入れて、小文字の拡張子名を取得しています。
実際の拡張子名は大文字・小文字の拡張子名が混在していますので、ここで小文字に統一して取得しています。
拡張子による分岐
Dim buf As Object
Select Case Extension
Case "xls", "xlsx", "xlsm"
～～～～～～～～～～
Case "doc", "docx", "docm"
～～～～～～～～～～
Case "ppt", "pptx", "pptm"
～～～～～～～～～～
End Select
すべてのファイルの中で、ここに挙げた9個の拡張子のファイルだけを対象としています。通常はこれで十分だと思います。
ただし、パワポのその他の拡張子のファイルを含めたい場合は改変が必要です。
テンプレート系の拡張子は「pot、potx、potm」、スライドショー系の拡張子は「pps、ppsx、ppsm」、アドイン系の拡張子は「ppa、ppam」ですので、「Case “ppt”, “pptx”, “pptm”」の後にそれぞれ追加してください。すると「For each ～ Next」を回す間に検索するようになります。
エクセルファイルの処理
Case "xls", "xlsx", "xlsm"
Set buf = Workbooks.Open(Filename:=TargetPath & "\" & File.Name)
With buf
If ThisWorkbook.FullName <> .FullName _
And Not LCase(.Name) Like "personal.xls?" Then
.SaveAs Filename:=.FullName, Password:=TargetPassword
.Close
End If
End With
Set buf = Nothing
Workbooks.Openメソッドではエラーがでました。Filenameパラメーターに「File.FullName」を指定したら、ファイルオープンに失敗しました。
原因だと推定しているのは、Workbook.FullName プロパティ (Excel)によると、「作業中のブックは、一度は保存されたことがあるものとします」という一文ではないかということです。英語では「assuming that the workbook has been saved」ということで、ブックを開いたあと一度は保存していないといけないのではないかと想像しています。
実際、「Filename:=TargetPath & “\” & File.Name」に変更したあとはきちんと動作しています。
For Each文で与えられるFileオブジェクトを操作するには、エクセルのブックとして開いて変数bufに格納します。
変数bufに格納したエクセルブックのオブジェクトが、このマクロを保存してあるブックや個人用マクロブックとは違うブックであることをIf文で確認して、大丈夫ならパスワードつきで保存して閉じます。
ワードファイルの処理
Case "doc", "docx", "docm"
Set buf = wdApp.Documents.Open(Filename:=TargetPath & "\" & File.Name)
With buf
.Saved = False
.SaveAs2 Filename:=.FullName, Password:=TargetPassword
.Close
End With
Set buf = Nothing
ワードには、エクセルやパワポにはない独特の設定があります。
それは「一度変更しないと、VBAで上書き保存することができない」という仕様です。
そのため、ここでは、文書に変更を加えるかわりに「Saved」プロパティに「False」を代入しています。
この場合、ドキュメントを閉じるときに（例え変更を加えていなくても）変更を保存するためのプロンプトが表示される、ということになります。
しかし、実際には「.DisplayAlerts = wdAlertsNone」という設定をしていますので、この設定の影響でプロンプトは表示されません。 その後、パスワードつきで名前をつけて保存して閉じます。
パワポファイルの処理
Case "ppt", "pptx", "pptm"
Set buf = ppApp.Presentations.Open(Filename:=TargetPath & "\" & File.Name, _
WithWindow:=msoFalse)
With buf
.Password = TargetPassword
.Save
.Close
End With
Set buf = Nothing
パワポを開くOpenメソッドは、上述した自分の勘違いからWithWindowパラメータを見つけて、msoFalseを設定することによって、プレゼンテーションを非表示にしています。
パワポのパスワードの設定方法は、エクセルやワードとは違います。まず、Passwordプロパティにパスワードを設定し、それから保存し閉じます。WithWindowパラメータとPasswordプロパティの存在から、パワポのVBAが一番合理的に作られているように思います。エクセルのVBAは一番歴史がある分、何でもできることが多いですが、あまり整理されていない感じがします。
サブフォルダ取得（再帰呼び出し）
Private Sub S_ProtectFiles_Core _
(ByVal TargetPath As String, ByVal TargetPassword As String)
～～～～～～～～～～～～～～～
Dim Folder As Object
For Each Folder In TargetFolder.SubFolders
Call S_ProtectFiles_Core(Folder.Path, TargetPassword)
Next Folder
～～～～～～～～～～～～～～～
End Sub
再帰呼び出しは、本マクロのように、あるプロシージャがそのプロシージャ内で自分自身を呼び出すような処理をいいます。
上記のコードのように、あるフォルダの下にあるファイルを，サブフォルダの中にあるファイルも含めて処理するような場合に威力を発揮します。
一見、無限ループになりそうな気がしますが、呼び出すフォルダをTargetFolderのサブフォルダに限定しているので、無限ループにはなりません。
1つのプロシージャの中で同じ名前のプロシージャを呼び出したとしても，引数や変数，プロシージャの戻り先などはメモリー上の別の領域に確保されて，別のプロシージャとして動作する仕組みになっています。
VBAのコマンドには、サブフォルダも含めて、あるフォルダに存在するファイル名の一覧を取得するものはありません。しかし、WindowsのDirコマンドを使えば、そのようなことは可能です。近いうちにDirコマンドバージョンの本マクロの改訂版も公開したいと思っています。
オブジェクト変数の解放
wdApp.Quit Set wdApp = Nothing ppApp.Quit Set ppApp = Nothing Set TargetFolder = Nothing Set FSO = Nothing
使わなくなったオブジェクト変数に「Nothing」を代入しています。
この処理は必要かどうかは「Set a = Nothing」のお話：Excel VBA | 即効テクニック | Excel VBAを学ぶならmougを見るとわかりやすいと思います。
わたしはいつも明示的に「Nothing」を代入する派です。
以上で、パスワード一括設定マクロの解説を終わります。
引き続き、パスワード一括解除マクロを解説します。
パスワード一括解除マクロのソース
Option Explicit
'「ツール(T)」⇒「参照設定(R)...」から以下のライブラリにチェックを
'入れてください。
'「Microsoft Scripting Runtime」
'「Microsoft Word 16.0 Object Library」（バージョンの数字は可変）
'「Microsoft Powerpoint 16.0 Object Library」（バージョンの数字は可変）
'***パスワード一括解除マクロ***
Public Sub S_UnprotectFiles_Main()
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
'パスワード解除用フォルダ取得
Dim TargetPath As String
TargetPath = F_GetTargetPath
If TargetPath = "" Then Exit Sub
'パスワード入力
Dim TargetPassword As Variant
TargetPassword = Application.InputBox _
("解除するパスワードを入力してください。", "パスワード入力")
If TargetPassword = False Then Exit Sub
'パスワード一括解除
Call S_UnprotectFiles_Core(TargetPath, TargetPassword)
With Application
.DisplayAlerts = True
.ScreenUpdating = True
End With
MsgBox "パスワード一括解除終了", vbOKOnly + vbInformation, _
"パスワード一括解除マクロ"
End Sub
'***パスワード解除用フォルダ取得***
Private Function F_GetTargetPath() As String
'フォルダ取得
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "パスワードを解除したいフォルダ(サブフォルダを含む)を" & _
"指定してください。"
.ButtonName = "フォルダ指定(&S)"
.InitialView = msoFileDialogViewList
.AllowMultiSelect = False
Select Case .Show
Case True
Dim Folder As String: Folder = .SelectedItems(1)
Case False
MsgBox "キャンセルが押されたので終了します。", _
vbOKOnly + vbExclamation, "プログラムの終了"
F_GetTargetPath = ""
Exit Function
End Select
End With
'フォルダ確認
Dim ans As VbMsgBoxResult
ans = MsgBox("パスワードを解除するフォルダ(サブフォルダを含む)は" _
& Folder & "ですね。", vbYesNo + vbInformation, "フォルダ確認")
Select Case ans
Case vbYes
F_GetTargetPath = Folder
Case vbNo
MsgBox "「いいえ」が押されたので終了します。", _
vbOKOnly + vbExclamation, "プログラムの終了"
F_GetTargetPath = ""
End Select
End Function
'***パスワード一括解除***
Private Sub S_UnprotectFiles_Core _
(ByVal TargetPath As String, ByVal TargetPassword As String)
'対象フォルダの特定
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
Dim TargetFolder As Object
Set TargetFolder = FSO.GetFolder(TargetPath)
'ワードオブジェクトの取得
Dim wdApp As Object
Set wdApp = CreateObject("Word.Application")
With wdApp
.DisplayAlerts = wdAlertsNone
.Visible = False
End With
'パワポオブジェクトの取得
Dim ppApp As Object
Set ppApp = CreateObject("Powerpoint.Application")
ppApp.DisplayAlerts = ppAlertsNone
'パスワード一括解除
Dim File As Object
For Each File In TargetFolder.Files
'拡張子取得
Dim Extension As String: Extension = LCase(FSO.GetExtensionName(File.Name))
'拡張子による分岐
Dim buf As Object
Select Case Extension
'エクセルファイルの処理
Case "xls", "xlsx", "xlsm"
Set buf = Workbooks.Open(Filename:=TargetPath & "\" & File.Name, _
Password:=TargetPassword)
With buf
If ThisWorkbook.FullName <> .FullName And _
Not LCase(.Name) Like "personal.xls?" Then
.SaveAs Filename:=.FullName, Password:=""
.Close
End If
End With
Set buf = Nothing
'ワードファイルの処理
Case "doc", "docx", "docm"
Set buf = wdApp.Documents.Open(Filename:=TargetPath & "\" & File.Name, _
PasswordDocument:=TargetPassword)
With buf
.Saved = False
.SaveAs2 Filename:=.FullName, Password:=""
.Close
End With
Set buf = Nothing
'パワポファイルの処理
Case "ppt", "pptx", "pptm"
Set buf = ppApp.Presentations.Open(Filename:=TargetPath & "\" & _
& File.Name & "::" & TargetPassword, WithWindow:=msoFalse)
With buf
.Password = ""
.Save
.Close
End With
Set buf = Nothing
End Select
Next File
'サブフォルダ取得（再帰呼び出し）
Dim Folder As Object
For Each Folder In TargetFolder.SubFolders
Call S_UnprotectFiles_Core(Folder.Path, TargetPassword)
Next Folder
'オブジェクト変数の解放
wdApp.Quit
Set wdApp = Nothing
ppApp.Quit
Set ppApp = Nothing
Set TargetFolder = Nothing
Set FSO = Nothing
End Sub
パスワード一括解除マクロの解説
ここでは、一括設定で説明した部分は割愛して、一括解除特有の部分についてのみ、もしくは私がここは説明しておいたほうがいいだろうと思う部分について説明したいと思います。
マクロ高速化・自動化のためのプロパティ設定
略
パスワード解除用フォルダ取得
Dim TargetPath As String TargetPath = F_GetTargetPath If TargetPath = "" Then Exit Sub
1つだけ説明を加えるとすれば、「S_ProtectFiles_Main()」（パスワード一括設定のメインプロシージャ）に含まれる同じ名前・同じ機能の「F_GetTargetPath」ファンクションプロシージャを使っているので、できれば1つにまとめたほうがいいと思います。
ここでは、説明上の利便性から別々にしています。
パスワード入力
Dim TargetPassword As Variant
TargetPassword = Application.InputBox _
("解除するパスワードを入力してください。", "パスワード入力")
If TargetPassword = False Then Exit Sub
「解除する」という文字列と「設定する」という文字列が違うだけで、あとは同じです。
パスワード一括解除
略
マクロ高速化・自動化のためのプロパティ設定の解除
略
パスワード解除用フォルダ取得サブルーチンの解説
フォルダ取得
略
フォルダ確認
略
パスワード一括解除サブルーチンの解説
対象フォルダの特定
略
ワードオブジェクトの取得
略
パワポオブジェクトの取得
略
パスワード一括解除
略
拡張子取得
略
拡張子による分岐
略
エクセルファイルの処理
Case "xls", "xlsx", "xlsm"
Set buf = Workbooks.Open(Filename:=TargetPath & "\" & File.Name, _
Password:=TargetPassword)
With buf
If ThisWorkbook.FullName <> .FullName And _
Not LCase(.Name) Like "personal.xls?" Then
.SaveAs Filename:=.FullName, Password:=""
.Close
End If
End With
Set buf = Nothing
パスワード設定とパスワード解除の大きな違いはこの部分に現れます。
1.ファイルを開く際に、パスワードを入力しておく。
2.ファイルを保存する際に、パスワードは入力しない。
この2つ以外は、設定のマクロと書くときと、解除のマクロを書くときで大きな違いはありません。
Set buf = Workbooks.Open(Filename:=TargetPath & "\" & File.Name, _
Password:=TargetPassword)
「Password:=TargetPassword」で、PasswordパラメータにTargetPassword変数に格納されているパスワードを代入することで、エクセルの手作業でいえば、読み取りパスワードの欄にパスワードを入力するのと同等のことをしています。これでパスワードつきのファイルを開きます。
.SaveAs Filename:=.FullName, Password:=""
Passwordパラメータに長さ0の文字列「””」を代入し、手作業でのパスワード欄を空欄にするのと同等のことをします。これでパスワードなしでファイルを名前をつけて保存しています。
長さ0の文字列「””」についてはNullとEmptyとNothingと空の文字列の違い｜Access VBA | 即効テクニック | Excel VBAを学ぶならmougが詳しいので、一読されることをおススメします。
ワードファイルの処理
Case "doc", "docx", "docm"
Set buf = wdApp.Documents.Open(Filename:=TargetPath & "\" & File.Name, _
PasswordDocument:=TargetPassword)
With buf
.Saved = False
.SaveAs2 Filename:=.FullName, Password:=""
.Close
End With
Set buf = Nothing
ワードVBAでは、読み取りパスワードは「PasswordDocument」という何とも意味不明な名前のパラメータに設定されます。名前に惑わされずにTargetPassword変数の値を格納します。
名前をつけて保存は、「SaveAs2」メソッドであり、読み取りパスワードはPasswordパラメータに長さ0の文字列「””」を代入することでパスワードなしでファイルを保存します。
「SaveAs2」メソッドはWord 2010以降使われるようになったメソッドで、Word 2007以前で使われていた「SaveAs」メソッドとは一部パラメータ（CompatibilityMode）の指定を除いて、ほとんど変わりはありません。わざわざメソッド名を変更するほどのこともなかったのに、Microsoftは変更してしまいました。
パワポファイルの処理
Case "ppt", "pptx", "pptm"
Set buf = ppApp.Presentations.Open(Filename:=TargetPath & "\" & File.Name & _
"::" & TargetPassword, WithWindow:=msoFalse)
With buf
.Password = ""
.Save
.Close
End With
Set buf = Nothing
パワポのVBAの仕様は、パスワードに関する限り、エクセルやワードのVBAの仕様にくらべてとてもシンプルでわかりやすいです。。。と書こうとしたのですが、とんでもなく難しい問題がありました。
パワポの「Open」メソッドには、「WithWindow」パラメータがありますが、パスワードに関するパラメータは存在しないのです。つまり、パスワードを指定してパワポのファイルを開くことはできないのです。
でも、それでは困るので、裏技的なパスワードの指定方法があります。
それは、ファイル名に続けてコロン2つ「::」をつらねて、その直後にパスワードを指定するというものです。
Set buf = ppApp.Presentations.Open(Filename:=TargetPath & "\" & File.Name & _
"::" & TargetPassword, WithWindow:=msoFalse)
この「Open」メソッドの中の「::」がカギです。これを書くことによってパスワードつきでファイルを開くことを実現しています。
パスワードを解除して保存するほうはカンタンです。
「Password」プロパティに長さ0の文字列「””」を代入するだけです。
.Password = ""
この件については、パスワード付きPowerPointファイルをマクロで扱うが詳しいですね。「既に::をパスワードに指定している場合は駄目とのこと。」だそうです。
サブフォルダ取得（再帰呼び出し）
略
オブジェクト変数の解放
略
おわりに
改訂前のマクロは単一のフォルダにしか対応していませんでした。しかし、本マクロは再帰呼び出しを使って複数のフォルダ（サブフォルダを含む）に対応したのが大きな違いになりました。
作成上のポイントとしては、Dir関数とFileSystemObjectオブジェクトが混在していたのを、再帰呼び出しを使うためにFileSystemObjectオブジェクトに統一したのが大きな違いです。興味のある方はDir関数を使ってチャレンジしてみてください。なぜか私の環境ではエクセルVBAでパワポオブジェクトを扱う際にDir関数が機能しませんでした。
本マクロを使っていただけると大変うれしいです。
コメントを残す