ある仕事で、Word文書から特定のデータを抽出して、Excelの表の所定の項目に代入するというマクロを作りました。
Excel側のVBAで作成するのですが、私はVBAに関しては門外漢です。そこでMSDNやネットなどを見まくって何とか作成しました。

ところが、事務所のPCでうまく行ったものが自宅のPCではうまく行かない事が判明しました。

調べてみると例によってバージョン違いによるエラーだということが分かったので、備忘録代わりに記事を書き留めておきます。

MSDNにあるFrameworkのオブジェクトやプロパティの記述は、英語版をもとに自動翻訳で日本語にされたものもあり、また記述が詳細さに欠ける箇所もあるため、実際に動かしてみない事には分からないところも多いです。そのため、テスト版を作りながら少しずつ肉付けしていくと言うやり方で開発しました。このように試行錯誤的に開発したのでいくつもの派生バージョンがあり、うまく行かないバージョンを自宅のPCで実験したのかと思いきや、実はWord(Microsoft Office)のバージョン違いによるものだった事が判明しました。

• 事務所：Microsoft Word 2016
• 自宅　：Microsoft Word 2013

うまく行かなかったのは、以下のコードの27行目「.Selection.Find.Execute」のところです。Find.Executeは実際に検索を実行するメソッドです。その前の行で検索文字列を指定してから検索します。ここで「実行時エラー’4605’アプリケーション定義またはオブジェクト定義のエラーです。」というエラーが出ました。

しかしながら、このエラーはMicrosoft Office 2016の環境では発生しませんでした。

Word2013には閲覧モードというモードがあり、そのモードで開かれたファイルに関しては「.Selection.Find.Execute」が定義エラーとなるようです。何故検索する事も出来ないのかは不明ですが、Findオブジェクトには置換モードもあります(当然、閲覧モードで置換は出来ません)ので、オブジェクトの定義ごと無効になるのかも知れません。

これを回避するためには、閲覧モードを解除しなければなりません。そこで必要となるのが24行目の「wDoc.ActiveWindow.View = wdPrintView」と言うコードです(wDocはローカルなオブジェクトなので、適宜読み替えてください)。これは「印刷レイアウトモード」にするというコードであり、このコードを実行する事により通常の編集モードとなります。

24行目のコードはMicrosoft Office 2016の環境で実行してもエラーになりません。

また「wdPrintView」はWordのコレクションなので、VBAのメニューから「ツール」⇒「参照設定」⇒「Microsoft Word 16.0 Object Library」(Office2016の場合)をチェックしていないとエラーになります。

※本コードはうまく行くようにしたものです。

Sub searchProc()
    Dim OpenFileName As String
    Dim wDoc As Object

    '画面更新を止める
    Application.ScreenUpdating = False
    '再計算を止める
    Application.Calculation = xlCalculationManual
    
    With CreateObject("Word.Application")

        ' エラーハンドラー
        On Error GoTo ErrHandler
        
        OpenFileName = Application.GetOpenFilename("Microsoft Word ドキュメント,*.doc?")
        If OpenFileName = "False" Then
            MsgBox "ファイルオープンに失敗しました"
            GoTo Finally
        Else

            'ファイルオープン（読み込み専用）
            Set wDoc = .Documents.Open(OpenFileName, ReadOnly = True, notify = False)
            'Word2013対応、閲覧モードの解除
            wDoc.ActiveWindow.View = wdPrintView
            '検索テスト
            .Selection.Find.Text = "検索文字列"
            If (.Selection.Find.Execute = True) Then
                Cells(1, 1) = .Selection.Sentences(1).Text
            Else
                Cells(1, 1) = ""
            End If

        End If
        
        GoTo Finally
        
ErrHandler:
        Resume Finally
    
Finally:
    If Not wDoc Is Nothing Then
        wDoc.Close
    End If
    .Quit Savechanges:=wdDoNotSaveChanges
    End With
    
    '画面更新を再開
    Application.ScreenUpdating = True
    '再計算を再開
    Application.Calculation = xlCalculationAutomatic
    Set wDoc = Nothing

End Sub

無性に気になる性格なので、3月21日(水)はこのことばかり実験してしまいました。

ツイート