差し込み印刷のデータソース接続前にデータソースの存否確認をする(Word) - 素人がExcelVBAによる「一人働き方改革」に挑むブログ

差し込み印刷のデータソース接続前にデータソースの存否確認をする

……などと、大それた標題をブチ上げたが、実質的な

敗北宣言

だと思っていただきたい。

いわば、爆負宣言である。

差し込み印刷のデータソースはExcel限定

実は、差し込み印刷の差し込みデータソースには、実に多様なものを指定することができる。

私は、Excel→Wordパターンしか知らなかった（だいたい、差し込み印刷というテクニックｗを覚えたのが５年前ぐらいなのだ。）ので、驚いた。ヒマな人は自分で調べてみてください。

今回は、Excel限定にする。……というか、それしか思い浮かばなかったのだ。結局。だから、敗北宣言。

ファイルの存在確認

まず、Excelのワークシートなり、セル範囲なりをデータソースに指定しているときは、当該のExcelブックが存在しなくてはいけない。これはめっちゃ簡単。

FileSystemObjectクラスのFileExsistsメソッドでOK。

シート・セル範囲の存在確認

で、問題はこいつ。

最初は、簡単にできると思っていた。

データソースに接続するときに、Document.MailMergeオブジェクトのOpenDataSourceメソッドでSQLを投げているっぽいので、データソースに指定したシート名なりセル範囲名に誤りがあったら、そこでエラーが出るやろ、と。

しかし、Word様は一枚上手だった。

f:id:akashi_keirin:20190716080550j:plain

データソースが見当たらなかったら、こんな風に、データソースの指定を促してくるのである。やられた。（ちなみに、ここで[キャンセル]を選択すると、実行時エラーになる。自動で[キャンセル]を選択するようにすれば、ここでエラーキャッチできるが、あまり美しいやり方ではない……。）

紆余曲折の末、現在の私のスキルレベルでは無理、と判断し、一番アホみたいな解決策をとった。

リスト１　標準モジュール

Private Function isCorrectTable( _
             ByVal dataSourceFilePath As String, _
             ByVal dataSourceTableName As String) As Boolean
  'Microsoft Excel XX.X Object Libraryを参照設定する'
  Dim ret As Boolean
  ret = False
  Dim tgtXls As Excel.Application
  Set tgtXls = New Excel.Application
  Dim tgtBook As Workbook
  Set tgtBook = tgtXls.Workbooks.Add(dataSourceFilePath)
  On Error GoTo Finalizer
  'テーブル名の右端が「$」ならば、シートを指定している'
  If Right(dataSourceTableName, 1) = "$" Then
    Dim tgtSheetName As String
    tgtSheetName = Left(dataSourceTableName, Len(dataSourceTableName) - 1)
    'シートの存否を確認'
    If sheetExists(targetBook:=tgtBook, _
                   targetSheetName:=tgtSheetName) Then
      ret = True: GoTo Finalizer
    Else
      GoTo Finalizer
    End If
  End If
  'テーブル名の右端が「$」でないならば、名前付きセル範囲を指定している'
  'アテ馬変数を準備'
  Dim stalkingHorse As Variant
  Set stalkingHorse = tgtXls.Range(dataSourceTableName)
  If stalkingHorse Is Nothing Then GoTo Finalizer  '……(*)'
  Set stalkingHorse = Nothing
  'ここまでたどり着いたということは、名前付きセル範囲があったということ'
  ret = True
Finalizer:
  Call tgtBook.Close(SaveChanges:=False)
  Call tgtXls.Quit
  Set tgtXls = Nothing
  Set tgtBook = Nothing
  isCorrectTable = ret
  If Err.Number > 0 Then Call Err.Clear
End Function

Private Function sheetExists( _
             ByVal targetBook As Workbook, _
             ByVal targetSheetName As String) As Boolean
  Dim ret As Boolean
  ret = False
  Dim i As Long
  With targetBook
    For i = 1 To .Worksheets.Count
      If .Worksheets(i).Name = targetSheetName Then
        ret = True
        Exit For
      End If
    Next
  End With
  sheetExists = ret
End Function

単なる力業ですよ、はい。

Excel→Wordの差し込み印刷についても、ちゃんと理解しているわけではないので、〈シート名での指定〉、〈セル範囲の名前での指定〉以外に指定方法があったらアウトｗ

エラーキャッチもたぶんかなり杜撰ｗ

(*)の

If stalkingHorse Is Nothing Then GoTo Finalizer

なんて、本当に必要なんかな、と思いますがｗ

実行

まず、このプロジェクト（SettingFile.docm）があるフォルダ内は

f:id:akashi_keirin:20190716080554j:plain

こんな状態。

差し込みデータソースInsertionData.xlsxは、この状態。

f:id:akashi_keirin:20190716080558j:plain

右側のセル範囲には、ご覧のようにSumoDataと名前を付けている。

この状態で実行してみる。

何せ、たかがデータソースの存否を確認するためだけに、わざわざExcelを起動するのだから、さぞかし時間がかかるに違いない、とお思いでしょう。

そこで、次のようなプロシージャで処理に要した時間を計測してみようと思う。

まず、リスト１を呼び出すプロシージャを作る。

リスト２　標準モジュール

Public Sub callIsCorrectTable()
  Debug.Print isCorrectTable( _
                ThisDocument.Path & "\InsertionData.xlsx", _
                "InsertionData$")
End Sub

で、こいつを自作の処理時間計測用メソッドにわたす。

参考　標準モジュール

'Declare Section'
Private Declare Function GetTickCount Lib "kernel32" () As Long

Public Function getElapsedTime(ByVal procedureName As String) As Double
  Dim startTime As Long
  Dim endTime As Long
  startTime = GetTickCount
  Call Application.run(procedureName)
  endTime = GetTickCount
  getElapsedTime = (endTime - startTime) / 1000
End Function

イミディエイト・ウインドウに、