ITリテラシーが高いはずのIT系企業に勤めていても「これはヤバくないか？」と思うExcelデータを普通に見れる状態でおいてあることもあります。
例えば
- やばい個人情報がもりもり入ったファイル（クレジット番号、マイナンバーなど）
- 本番環境のユーザID、パスワード、IPなどが記載されているファイル
実際今働いている職場で、Slackを使用して本番接続情報の入ったExcelが送られてきて軽く戦慄しました。
間違えて他人に添付してしまった時、取り返しがつかないダメージを負いますよね。そんな時パスワードを掛けていれば最小限のダメージで済みます。
そこでガチでやばい情報を扱うExcelは、保存時にパスワードをかけるのを必須にしたほうが良いと思い記事にしてみることにしました。
デフォの機能でパスワード必須にさせるのは難しいみたい
Excelにはデフォルトの機能で、保存時にパスワードを設定するというものがあります。
この機能を使用すれば、パスワードを掛けることが出来、比較的安全に重要データを取り扱うことが出来ます。
そこでグループポリシーなどでパスワードを強制することが出来ないか調べてみたのですが、どうも難しそうです。
それでは、重要データを取り扱うExcelファイルのテンプレートでパスワードを必須にする機能をONにすればよいのではないかと考えました。
…が、そもそもそんな機能自体が見つかりませんでした。
「パスワードつけるかどうかは完全に個人の判断に任せる」というのがExcelのポリシーということでしょうか。
VBAで強制的に全般オプションを呼び出す→無理でした
そこでWorkBookの「Workbook_BeforeSave」イベントにて、前述した全般オプションを呼び出してあげればいいと思いました。
↓これ
しかし、このフォーム自体を呼び出す関数は用意されていないようでした。結構使いそうな機能なのに…。
こうなると、もう完全に自作をしていくしかなさそうですね…。
自作関数で強制をしてみた
「Workbook_BeforeSave」イベントにてパスワード入力を強制して、パスワードが入力されていなかったら保存をさせないようにします。
パスワードは、パスワードフィールドでマスクし、下記のようなフォームで２回入力させるのが適当かと思います。
パスワードはTextBoxのPasswordCharに値を入れてあげればOKです。
ただフォームを作るのが面倒だったので、今回はお試しなので適当にInputBoxから入力させることにしました。
Private pass As String
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim msg As String
If pass = "" Then
'パスワードを強制する
msg = "読み取りパスワードを入力してください。"
pass = InputBox(msg)
If pass = "" Then
'パスワード未設定
MsgBox "パスワード未設定では保存できません"
Cancel = True
End If
Application.DisplayAlerts = False
If SaveAsUI Then
'「名前を付けて保存する」
Save_File = Application.GetSaveAsFilename(ThisWorkbook.Name, FileFilter:="Excelファイル,*.xlsx,すべてのファイル,*.*")
ActiveWorkbook.SaveAs Filename:=Save_File, FileFormat:=xlNormal, Password:=pass
Else
'上書き保存
ThisWorkbook.SaveAs ThisWorkbook.Path & "\" & ThisWorkbook.Name, Password:=pass
End If
Application.DisplayAlerts = True
End If
End Sub
InputBoxでパスワードを入力させ、入力がなければ保存をキャンセルします。(Cancelにfalseを設定)
SaveAsUI で「名前を付けて保存」か「上書き保存」かを取得できます。
名前を付けて保存の場合はダイアログを出して保存先を指定、上書き保存の場合は現在のブック名で保存させます。
保存時に「Password」という引数に読み取りパスワードを設定します。
「Workbook_BeforeSave」内で保存処理を呼び出すと再帰呼び出しになりループしてしまうので、既にパスワードが入力済みの時は何もしないようにします。
もうパスワードが設定されていたら何もしない
「毎回パスワード設定するの面倒だよ」という時のために、パスワードが既に設定されていたら何もしないという感じにします。
Private pass As String
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim msg As String
'既にパスワードがあれば何もしない
If ThisWorkbook.HasPassword Then Exit Sub
If pass = "" Then
'パスワードを強制する
msg = "読み取りパスワードを入力してください。"
pass = InputBox(msg)
If pass = "" Then
'パスワード未設定
MsgBox "パスワード未設定では保存できません"
Cancel = True
End If
Application.DisplayAlerts = False
If SaveAsUI Then
'「名前を付けて保存する」
Save_File = Application.GetSaveAsFilename(ThisWorkbook.Name, FileFilter:="Excelファイル,*.xlsx,すべてのファイル,*.*")
ActiveWorkbook.SaveAs Filename:=Save_File, FileFormat:=xlNormal, Password:=pass
Else
'上書き保存
ThisWorkbook.SaveAs ThisWorkbook.Path & "\" & ThisWorkbook.Name, Password:=pass
End If
Application.DisplayAlerts = True
End If
End Sub
ThisWorkbook.HasPasswordでパスワードの設定有無を取れるので、既に設定されていれば何もしないようにします。
その他に考慮したいこと
このEXCELを配る時にパスワードを一旦消したいということもあるかと思います。
その場合は、別のExcelのVBAからパスワードを消して保存するしかないかなあと思います。
その際に、保存時にパスワードを掛けないフラグみたいのを持たせておく感じが良いかと思います。（悪用されたら面倒ですが…）
Private pass As String
Public flg As Boolean
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim msg As String
'パスワード消去フラグがオン
If flg Then
If Not ThisWorkbook.HasPassword Then Exit Sub
ThisWorkbook.SaveAs ThisWorkbook.Path & "\" & ThisWorkbook.Name, Password:=""
End If
'既にパスワードがあれば何もしない
If ThisWorkbook.HasPassword Then Exit Sub
If pass = "" And Not flg Then
'パスワードを強制する
msg = "読み取りパスワードを入力してください。"
pass = InputBox(msg)
If pass = "" Then
'パスワード未設定
MsgBox "パスワード未設定では保存できません"
Cancel = True
End If
Application.DisplayAlerts = False
If SaveAsUI Then
'「名前を付けて保存する」
Save_File = Application.GetSaveAsFilename(ThisWorkbook.Name, FileFilter:="Excelファイル,*.xlsx,すべてのファイル,*.*")
ActiveWorkbook.SaveAs Filename:=Save_File, FileFormat:=xlNormal, Password:=pass
Else
'上書き保存
ThisWorkbook.SaveAs ThisWorkbook.Path & "\" & ThisWorkbook.Name, Password:=pass
End If
Application.DisplayAlerts = True
End If
End Sub
別のVBAから上記関数のflgをTrueにしてパスワードを消去させます。
まあその時に、そもそもExcelにかかっているパスワードがないとアクセスできないので、適当に保存しておくと詰みそうですが…。
コメントを残す