差込データソースとの接続をVBAで行う

WordVBA VBA覚書

VBAで差込印刷のデータソースに接続する

差込印刷データソースの指定

以前、差込印刷のレコードごとにWordファイルを生成するということをやったことがあった。

akashi-keirin.hatenablog.com

これはこれで、メチャクチャ便利で、重宝しているんだが、フォルダを移動したり、ネットワークドライブでドライブレターが異なる人が使う場合に、いちいち
差込文書→宛先の選択
でExcelファイルを指定し直さないといけなかったり、ファイルを指定するときのデフォルトのフォルダが変なところになっていたりするので、非常にフラストレーションが溜まる。

で、「差込データソースとの接続をマクロでやっちゃえ！」と思って、やってみた。

同じフォルダ内にある指定したブックの指定したシートをデータソースに指定するマクロ

標準モジュールに次のようなコードを書いた。

リスト１　標準モジュール
Public Sub setMailMergeDataSource(ByVal objDoc As Document, _
                                  ByVal objFileName As String, _
                                  ByVal objSheetName As String)    '……(1)'
On Error GoTo errorHandler
  Dim dataSourceFullName As String
  dataSourceFullName = objDoc.Path & "\" & objFileName    '……(2)'"
  With objDoc.MailMerge    '……(3)'
    .OpenDataSource Name:=dataSourceFullName, _
                    SQLStatement:="SELECT * FROM `" & objSheetName & "$`"
  End With
  Exit Sub
errorHandler:
End Sub

引数を受け取って処理をする。(1)の

Public Sub setMailMergeDataSource(ByVal objDoc As Document, _
                                  ByVal objFileName As String, _
                                  ByVal objSheetName As String)

では、引数を３つ設定している。

第１引数のobjDocは、差込先のWordドキュメント。

第２引数のobjFileNameは、差込データソースに指定するExcelファイルのファイル名（拡張子付き）。

第３引数のobjSheetNameは、データソースのあるシート名。

とりあえずこの３つを受け取って処理をすることにしている。

(2)の

dataSourceFullName = objDoc.Path & "\" & objFileName

では、変数dataSourceFullNameに差込データソースのExcekファイルのフルパスをぶち込んでいる。

んで、(3)からの４行（実質３行）

With objDoc.MailMerge
  .OpenDataSource Name:=dataSourceFullName, _
                  SQLStatement:="SELECT * FROM `" & objSheetName & "$`"
End With

では、Document.MailMergeオブジェクトのOpenDataSourceメソッドを使って、差込データソースを接続している。

OpenDataSourceメソッドにはたくさん引数があるが、とりあえずNameとSQLStatementを指定しておけば大丈夫っぽい。

実行

実行元のWordドキュメントのあるフォルダ内に「test.xlsx」というExcelブックを用意しておき、その「競輪選手」シートに

f:id:akashi_keirin:20171125215357j:plain

こんなデータ（ｗ）を用意しておく。

で、次のコードで実行してみる。

リスト２　標準モジュール
Public Sub connectingDataSourceTest()
  Dim orgDoc As Document    '……(1)'
  Set orgDoc = ActiveDocument
  Dim rootPath As String    '……(2)'
  rootPath = orgDoc.Path & "\"    '"
  Dim newDoc As Document    '……(3)'
  Set newDoc = Documents.Add
  newDoc.SaveAs2 rootPath & "ち～んｗ.docx"    '……(4)'
  Call setMailMergeDataSource(newDoc, "test.xlsx", "競輪選手")    '……(5)'
End Sub

まず、(1)からの２行

Dim orgDoc As Document
Set orgDoc = ActiveDocument

で変数orgDocに実行元ドキュメントをぶち込んでおく。

(2)からの２行

Dim rootPath As String
rootPath = orgDoc.Path & "\"

で、変数rootPathに実行元ドキュメントのあるフォルダのパスをぶち込んでおく。

(3)からの２行

Dim newDoc As Document
Set newDoc = Documents.Add

で、DocumentsコレクションのAddメソッドを用いて新しいドキュメントを生成し、即座に変数newDocにぶち込む。

さらに(4)の

newDoc.SaveAs2 rootPath & "ち～んｗ.docx"

で、実行元ドキュメントと同じフォルダに「ち～んｗ.docx」という名で保存する。

あとは、(5)の

Call setMailMergeDataSource(newDoc, "test.xlsx", "競輪選手")

でリスト１のsetMailMergeDataSourceメソッドを呼び出したらおしまい。

「ち～んｗ.docx」の差込文書に、同じフォルダ内の「test.xlsx」を設定する。

実行結果

まず、

f:id:akashi_keirin:20171125215450j:plain

このように「ち～んｗ.docx」が生成される。

で、「差込フィールドの挿入」をクリックしてみると、

f:id:akashi_keirin:20171125215501j:plain

ちゃんと設定されている。

f:id:akashi_keirin:20171125215514j:plain

こんなふうに差込フィールドを挿入して、「結果のプレビュー」をクリックしてみると……

f:id:akashi_keirin:20171125215528j:plain

ほれ、ちゃんとデータが差し込まれる。

おわりに

なんでこんな簡単なことを今までやってなかったんだろ？？？

こちらもどうぞ

akashi-keirin.hatenablog.com