【初心者の備忘録】VBScript - Wordファイルを作成して印刷する

前提

1. Officeバージョン：2003
2. WinActor（RPAツール）シナリオに部品として組み込む。

動作

• 特定のフォルダに格納されているPDFファイルに対し、チェック票を作成したい。
• その際にPDFファイル名に載っている情報を取得し、チェック票に反映させた上で
  印刷したい。

1. デスクトップ上に「資料チェック票.doc」を作成する。（ファイル名重複時は既存のファイルを削除する）
2. 本文に基礎情報を入力する。
3. 指定フォルダ内のPDF名から必要な情報を取得し、本文に反映する。
4. Wordファイルを印刷する。

【Sample】

①Wordファイルのフルパスを設定

• ファイル名：資料チェック票.doc
• 保存先　　：デスクトップ（C:\Users\【UserName】\Desktop）

getFilePath.vbs

Option Explicit
' 定数
Const strFileName = "資料チェック票.doc"
' 変数
Dim objShell
Dim objFSO
Dim strDesktop
Dim strFilePath

' デスクトップのパスを求める
Set objShell = CreateObject("WScript.Shell") 
strDesktop = objShell.SpecialFolders("desktop") 

'　wordファイルのフルパスを作成する
Set objFSO = CreateObject("Scripting.FileSystemObject")
strFilePath = objFSO.BuildPath(strDesktop, strFileName)

' ファイル名の重複を確認
If objFSO.FileExists(strFilePath) = True Then
   ' 重複していた場合は、今あるファイルを削除する
   objFSO.DeleteFile strFilePath
End If

' オブジェクト破棄
Set objShell = Nothing
Set objFSO = Nothing

②Wordファイルの雛形を作成

• 本文タイトル：日次資料チェック票
• 作成項目：
  • 資料番号※英字4字＋数字6字
  • 発行者ID※英字2字＋数字4字
  • 資料発行日
  • チェック票出力日時

createWordDocument.vbs

Option Explicit
' ※引数
Dim strFilePath ' getFilePath.vbsで取得したパス
	strFilePath = "C:\Users\【UserName】\Desktop\資料チェック票.doc"

Const FontName = "ＭＳ ゴシック"
Const baseFontSize = 15
Const maxFontSize = 20
Const minFontSize = 12
' 変数
Dim objWord
Dim objDoc
Dim objTable
Dim targetArray
Dim i

' Wordドキュメントを作成
Set objWord = CreateObject("Word.Application")
With objWord
    .Visible = True
    Set objDoc = .Documents.Add()
End With

'最初に表以外の文章を配置する
With objWord.Selection
    'フォント(共通)
    .Font.Name = FontName
    '【1行目】タイトル
    .Font.Size = maxFontSize
    .TypeText "＜日次資料チェック票＞"
    .TypeParagraph()
    '【2行目】空行
    .TypeParagraph()
    '【3行目】本文：資料番号（小タイトル）
    .Font.Size = baseFontSize
    .TypeText "■資料番号："
    .TypeParagraph()
    '【4行目】本文：資料番号（チェック欄）
    .Font.Size = minFontSize
    .TypeText "チェック欄"
    .TypeParagraph()
    '【5行目】本文：資料番号			' ※後ほど票挿入する段落(5)
    .Font.Size = baseFontSize
    .TypeText ""
    .TypeParagraph()
    '【6行目】空行
    .TypeParagraph()
    '【7行目】本文：発行者ID（小タイトル）
    .TypeText "■発行者ID："
    .TypeParagraph()
    '【8行目】本文：発行者ID（チェック欄）
    .Font.Size = minFontSize
    .TypeText "チェック欄"
    .TypeParagraph()
    '【9行目】本文：発行者ID			' ※後ほど票挿入する段落(9)
    .Font.Size = baseFontSize
    .TypeText ""
    .TypeParagraph()
    '【10行目】空行
    .TypeParagraph()
    '【11行目】本文：発行日（小タイトル）
    .TypeText "■資料発行日："
    .TypeParagraph()
    '【12行目】本文：発行日（チェック欄）
    .Font.Size = minFontSize
    .TypeText "チェック欄"
    .TypeParagraph()
    '【13行目】本文：発行日			' ※後ほど票挿入する段落(13)
    .Font.Size = baseFontSize
    .TypeText ""
    .TypeParagraph()
    '【14行目】空行
    .TypeParagraph()
    '【15行目】本文：チェック票出力日時（小タイトル）
    .TypeText "■チェック票出力日時："
    .TypeParagraph()
    '【16行目】本文：チェック票出力日時
    .TypeText "　　"
    .TypeParagraph()
End With

' 表を挿入する行を配列に格納する（エラー回避のため末尾から設定）
targetArray = Array(13, 9, 5)

' 末尾から表挿入する（上からだとエラーになる）
For i = LBound(targetArray) To UBound(targetArray)
    Set objTable = Nothing  ' 初期化

    objDoc.Tables.Add objDoc.Paragraphs(targetArray(i)).Range, 1, 2
    Set objTable = objDoc.Tables(1)
  
    With objTable
      .Columns(1).Cells.Width = 65
      .Columns(2).Cells.Width = 365
      .Cell(1, 2).Range.Borders.OutsideLineStyle = 0	'罫線なし
      .Cell(1, 1).Range.Borders.OutsideLineStyle = 1	'実線
    End With
Next

'保存と終了([Doc]Save⇒[Doc]Close⇒[App]Quitの順)
objDoc.SaveAs strFilePath
objDoc.Close
objWord.Quit

' オブジェクト破棄
Set objWord = Nothing
Set objDoc = Nothing
Set objTable = Nothing

③指定ファイルから項目情報を取得

• 指定フォルダ：C:\temp\日次資料
• ファイル名構成："資料発行日" _ "資料番号" _ "発行者ID".pdf
  • 例：20190601_ABCD123456_XY0001.pdf

※指定フォルダ内にファイルは1つのみと想定。
※取得したデータは配列に格納する。

getArrayData.vbs

Option Explicit
' 定数
Const strFolderPath = "C:\temp\日次資料"
' 変数
Dim objFSO
Dim objFolder
Dim f
Dim tmpExtension
Dim tmpFileName
Dim arrayData

' フォルダオブジェクトを取得
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(strFolderPath)

' フォルダ内のPDFファイルの名前を取得
tmpFileName = ""
For Each f In objFolder.Files
   tmpExtension = objFSO.GetExtensionName(f.Name)  ' 拡張子
   If LCase(tmpExtension) = "pdf" Then
      tmpFileName = Replace(LCase(f.Name), ".pdf", "")
      Exit For
   End If
Next

' ファイル名を配列化する
If tmpFileName = "" Then
   arrayData = Array("")
Else
   arrayData = Split(tmpFileName, "_")
End If

' オブジェクト破棄
Set objFSO = Nothing
Set objFolder = Nothing

④取得した情報をWordドキュメントに反映して印刷

docPrintOut.vbs

Option Explicit
' ※引数
Dim arrayData	' getArrayData.vbsで取得したデータ（配列）
	arrayData = Array("20190601", "ABCD123456", "XY0001")
Dim strFilePath	' createWordDocument.vbsで作成したファイルパス
	strFilePath = "C:\Users\【UserName】\Desktop\資料チェック票.doc"
' 変数
Dim objWord
Dim objDoc
Dim arrayTableValue(3)
Dim i
Dim num

' 資料発行日は「●●●●/●/●」のかたちにする
arrayData(0) = CInt(Left(arrayData(0), 4)) * 1 & "/" & _
	       CInt(Mid(arrayData(0), 5, 2)) * 1 & "/" & _
	       CInt(Right(arrayData(0), 2)) * 1

' 表（テーブル）の番号と代入する配列データを一致させる
arrayTableValue(1) = CStr(arrayData(1))   ' 資料番号
arrayTableValue(2) = CStr(arrayData(2))   ' 発行者ID
arrayTableValue(3) = CStr(arrayData(0))   ' 資料発行日

' Wordドキュメントを立ち上げる
Set objWord = CreateObject("Word.Application")
objWord.Visible = True
Set objDoc = objWord.Documents.Open(strFilePath)

' 表に値を反映（1：資料番号／2：発行者ID／3：資料発行日）
For i = 1 to 3
   objDoc.Tables(i).Cell(1, 2).Range.Text = arrayTableValue(i)
Next

' 最終行（16行目）のチェック票出力日時に現在時刻を反映
num = objDoc.Sentences.Count
objDoc.Sentences(num).Text = FormatDateTime(Now, 0)

' 印刷
objDoc.PrintOut

'保存せずに閉じる
objdoc.Close 0
objWord.Quit

' オブジェクト破棄
Set objWord = Nothing
Set objDoc = Nothing

⑤Wordファイルを削除する

docDelete.vbs

Option Explicit
' ※引数
Dim strFilePath ' createWordDocument.vbsで作成したファイルパス
    strFilePath = "C:\Users\【UserName】\Desktop\資料チェック"
' 変数
Dim objFSO
Dim blnResult

' ファイルを削除する
Set objFSO = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
   objFSO.DeleteFile strFilePath, True
   ' 削除できたらTrue、できなければFalse
   blnResult = (Err.Number = 0)		

' オブジェクト破棄
Set objFSO = Nothing

以上。

---