Officeファイルの読み取り専用パスワード有無を判定する（普通のやり方、処理に時間がかかります・・・）

ExcelやWordなどOfficeファイルに読み取り専用パスワードがかかっているか、マクロで判定したい局面があります。この処理を行う様々な記事やコードがWeb上で公開されていますが、マクロでファイルを開いてみて、うまく開けなかったら読み取り専用パスワードがあると判断するというロジックが多いようです。私も次のようなコードで処理していました。

'---------------------------------------------------------------
'Officeファイル（Excel、Word,PowerPoint）のパスワードを判定
'---------------------------------------------------------------

Function IsPassOffice(Path As String) As String

    Dim objApp As Object, objFile As Object
    Dim ErrNo As Long, ErrStr As String, Kcs As String, xlF As Boolean
    
    '拡張子の取得
    Kcs = Replace(LCase(Right(Path, 4)), ".", "")
    
    '各Officeアプリでファイルを開く
    On Error Resume Next
    Select Case Kcs
        Case "doc", "docx", "docm"
            With CreateObject("Word.Application")
                Set objFile = .Documents.Open(Path, passworddocument:="unknown")
                ErrNo = Err.Number
                ErrStr = Err.Description
                .Quit
            End With
        Case "ppt", "pptx", "pptm"
            With CreateObject("PowerPoint.Application")
                objFile = .Presentations.Open(Path & "::unknown")
                ErrNo = Err.Number
                ErrStr = Err.Description
                .Quit
            End With
        Case "xls", "xlsx", "xlsm"
            With CreateObject("Excel.Application")
                Set objFile = .Workbooks.Open(Path, Password:=vbNullString)
                ErrNo = Err.Number
                ErrStr = Err.Description
                .DisplayAlart = False
                .Quit
            End With
        Case Else
            IsPassOffice = "Officeファイルではありません"
            Exit Function
    End Select
    On Error GoTo 0
    
    'Err.NumberとErr.Descriptionからパスワードの有無を判定
    If InStr(ErrStr, "パスワード") > 0 Or InStr(ErrStr, "'Open' メソッドは失敗しました") Then
        IsPassOffice = "パスワード有（" & ErrStr & "）"
    ElseIf ErrNo = 0 Then
        IsPassOffice = "パスワードなし"
        Set objFile = Nothing
    Else
        IsPassOffice = "不明"
    End If
    
End Function

'---------------------------------------------------------------

'Officeファイル（Excel、Word,PowerPoint）のパスワードを判定

'---------------------------------------------------------------

Function IsPassOffice(Path As String) As String

Dim objApp As Object, objFile As Object

Dim ErrNo As Long, ErrStr As String, Kcs As String, xlF As Boolean

'拡張子の取得

Kcs = Replace(LCase(Right(Path, 4)), ".", "")

'各Officeアプリでファイルを開く

On Error Resume Next

Select Case Kcs

Case "doc", "docx", "docm"

With CreateObject("Word.Application")

Set objFile = .Documents.Open(Path, passworddocument:="unknown")

ErrNo = Err.Number

ErrStr = Err.Description

.Quit

End With

Case "ppt", "pptx", "pptm"

With CreateObject("PowerPoint.Application")

objFile = .Presentations.Open(Path & "::unknown")

ErrNo = Err.Number

ErrStr = Err.Description

.Quit

End With

Case "xls", "xlsx", "xlsm"

With CreateObject("Excel.Application")

Set objFile = .Workbooks.Open(Path, Password:=vbNullString)

ErrNo = Err.Number

ErrStr = Err.Description

.DisplayAlart = False

.Quit

End With

Case Else

IsPassOffice = "Officeファイルではありません"

Exit Function

End Select

On Error GoTo 0

'Err.NumberとErr.Descriptionからパスワードの有無を判定

If InStr(ErrStr, "パスワード") > 0 Or InStr(ErrStr, "'Open' メソッドは失敗しました") Then

IsPassOffice = "パスワード有（" & ErrStr & "）"

ElseIf ErrNo = 0 Then

IsPassOffice = "パスワードなし"

Set objFile = Nothing

Else

IsPassOffice = "不明"

End If

End Function

このように呼び出して使用します。

Sub OfficeMain()
    Dim Path As String
    Path = ThisWorkbook.Path & "\files\doc.doc"
    Debug.Print IsPassOffice(Path)
End Sub

Sub OfficeMain()

Dim Path As String

Path = ThisWorkbook.Path & "\files\doc.doc"

Debug.Print IsPassOffice(Path)

End Sub

ファイルの種類に応じて、Excel、Word、PowerPointのアプリケーションオブジェクトを生成、実際にファイルを開いてみて、開けなかったら「パスワード有」と判定する処理で、判定したいファイルのフルパスを渡すと、パスワードの有無が文字列が返ってきます。また、ファイルオープン時のエラーDescription文字列も（）書きで返すようにしています。

エラーDescription文字列はアプリケーションによってまちまちで、次のような感じです。
　パスワード有（’Open’ メソッドは失敗しました: ‘Presentations’ オブジェクト）
　パスワード有（Presentations.Open : 読み取りパスワードをもう一度入力してください(&P):）
　パスワード有（パスワードが正しくありません。文書を開けません。パスワード有（入力したパスワードが間違っています。CapsLock キーの状態に注意して、大文字と小文字が正しく使われていることを確認してください。）

このコードは、毎回、アプリケーションオブジェクトをCreateしているので、連続処理する場合は、PublicやPrivateなど広域変数でobjAppとobjFileを宣言、呼び出し側のMainプロシージャでCreateしたアプリケーションオブジェクトを使いまわすのがよいと思います。

実務上は、これで問題ないのですが、大量のファイルを対象に判定処理する場合、時間がかかってしまうんですよね。それはそうです、実際にファイルを開いちゃっているわけですから。これを何とか高速処理したいと思ってしまい、その方法を次のエントリーで紹介したいと思います。