VBScript集

最終更新日：2021/3/12

LVURLExtractionで『ダウンロードした画像ファイルをPDFによる結合して一つのファイルに纏めたい』という課題があります。Acrobatを起動して数回の操作で実現出来るのですが、LVURLExtractionにボタンを追加して、そのボタンを押したら勝手にバッチ処理して欲しいと思っています。
その過程で実現方法を探っているのですが、いくつか判った事があります。

と云う事で、Webサイトに散らばっている便利なVBScriptを集めておこうと思いました。

  1. 2つ以上のPDFファイルを纏めてドロップすると1つの結合したPDFファイルを生成する。
  2. 幾つかのファイルが入ったフォルダをドロップするとファイル名をリストアップしたテキストファイルを生成。ファイル名はそのフォルダ名.txt
  3. ドロップされたファイルまたはフォルダのパスを配列に取得
  4. フォルダ内のPDFファイル数をカウントする
  5. フォルダ内のPDFファイル数を結合する

【2つ以上のPDFファイルを纏めてドロップすると1つの結合したPDFファイルを生成する。】

'**********************************************
' Acrobatを使ってPDFファイルを結合するVBScript
' @kinuasa
'**********************************************
Option Explicit
 
Dim		args
Dim		fso
Dim		pdoc
Dim		n, ts, fp
Dim		cnt, i
Const	PDSaveFull = 1
Const	OutputFileName = "merged_"					'結合後のファイル名
 
Set args = WScript.Arguments
If args.Count < 1 Then
	MsgBox "当スクリプトにPDFファイルをドラッグ＆ドロップして処理を実行してください。", vbExclamation + vbSystemModal
	WScript.Quit
End If
 
cnt = 0
Set fso = CreateObject("Scripting.FileSystemObject")
For i = 0 To args.Count - 1
	Select Case LCase(fso.GetExtensionName(args(i)))
		Case "pdf":		cnt = cnt + 1
		Case "jpg":		cnt = cnt + 1
		Case "jpeg":	cnt = cnt + 1
		Case "png":		cnt = cnt + 1
	End Select
Next
If cnt < 2 Then
  MsgBox "2個以上のPDF,画像ファイルを選択してください。", vbExclamation + vbSystemModal
  WScript.Quit
End If
 
'出力先設定
n = Now()
ts = Year(n) & Right("0" & Month(n), 2) & Right("0" & Day(n), 2) & Right("0" & Hour(n), 2) & Right("0" & Minute(n), 2) & Right("0" & Second(n), 2)
fp = fso.BuildPath(fso.GetFile(args(0)).ParentFolder.Path, OutputFileName & ts & ".pdf")
 
With CreateObject("AcroExch.PDDoc")
	If .Create = True Then
		Set pdoc = CreateObject("AcroExch.PDDoc")
		For i = 0 To args.Count - 1
			Select Case LCase(fso.GetExtensionName(args(i)))
				Case "pdf":
					If pdoc.Open(args(i)) = True Then
						.InsertPages .GetNumPages() - 1, pdoc, 0, pdoc.GetNumPages() - 1, True
						pdoc.Close
					End If
				Case "jpg":
					If pdoc.Open(args(i)) = True Then
						.InsertPages .GetNumPages() - 1, pdoc, 0, pdoc.GetNumPages() - 1, True
						pdoc.Close
					End If
				Case "jpeg":
					If pdoc.Open(args(i)) = True Then
						.InsertPages .GetNumPages() - 1, pdoc, 0, pdoc.GetNumPages() - 1, True
						pdoc.Close
					End If
				Case "png":
					If pdoc.Open(args(i)) = True Then
						.InsertPages .GetNumPages() - 1, pdoc, 0, pdoc.GetNumPages() - 1, True
						pdoc.Close
					End If
			End Select
		Next
		Set pdoc = Nothing
		.Save PDSaveFull, fp
		.Close
	End If
End With
 
MsgBox "結合したPDFファイルを【" & fp & "】に保存しました。", vbInformation + vbSystemModal

【幾つかのファイルが入ったフォルダをドロップするとファイル名をリストアップしたテキストファイルを生成。ファイル名はそのフォルダ名.txt】

'**********************************************
'フォルダをドラッグ & ドロップすると、フォルダ内のファイルリストを テキストファイルに出力する VBScript
'**********************************************
Option Explicit
DIM	ForReading
DIM	ForWriting
DIM	ForAppending
DIM	args
DIM	objFileSys
DIM	objFolder
DIM	pos
DIM	InputFolderName
DIM	PathOutput
DIM	fileWriter
DIM	f
'--------------------------------引数が無かった時の処理
If WScript.Arguments.count = 0 then
	WScript.Echo "引数が無いため、実行できません。" & vbNewLine & "フォルダをドロップしてください。"
	WScript.Quit
end If
'--------------------------------ファイル入出力用の変数
ForReading		= 1
ForWriting		= 2
ForAppending	= 3
'--------------------------------フォルダ内ファイルリスト出力
for each args In WScript.Arguments
	' ファイルシステムオブジェクト作成
	Set objFileSys = CreateObject("Scripting.FileSystemObject")
	' ドロップされた引数がフォルダかファイルかを判定する
	If objFileSys.FolderExists(args) then
		' is folder.
	ElseIf objFileSys.FileExists(args) then
		' is file.
		WScript.Echo "ファイルがドロップされました。" & vbNewLine & "処理を終了します。"
		WScript.Quit
	else
		' is unknown.
		WScript.Echo "フォルダ 及び ファイル とも認識できないデータがドロップされました。" & vbNewLine & "処理を終了します。"
		WScript.Quit
	End If
	' ドロップされたフォルダのオブジェクト取得
	Set objFolder = objFileSys.GetFolder(args)
	' ファイルが見つからなかった場合、プログラムを終了する
	If objFolder.Files.Count = 0 then
		WScript.Echo "ファイルは見つかりませんでした。"
		WScript.Quit
	End If
	' 出力ファイルパスの作成
	pos				= InstrRev(args, "\")
	InputFolderName = Mid(args, pos + 1)
	PathOutput		= Left(args, pos) & "\" & InputFolderName & "-FileList" & ".txt"
	' テキストファイルを開く
	Set fileWriter	= objFileSys.OpenTextFile(PathOutput, ForWriting, True)
	' 出力
	for each f In objFolder.Files
		fileWriter.Write f.Name				& vbTAB
		fileWriter.Write f.Type				& vbTAB
		fileWriter.Write f.Size				& vbTAB
		fileWriter.Write f.DateCreated		& vbTAB
		fileWriter.Write f.DateLastAccessed & vbTAB
		fileWriter.Write f.DateLastModified & vbTAB
		fileWriter.Write f.Attributes		& vbCR
	next
	' テキストを閉じる
	fileWriter.Close
	' ドロップされたフォルダのオブジェクトの破棄
	Set objFolder	= Nothing
	' ファイルシステムオブジェクトの破棄
	Set objFileSys	= Nothing
	' 作成したファイルリストを開く
	' Set objWsh	= WScript.CreateObject("WScript.Shell")
	' objWsh.Run PathOutput
	' Set objWsh	= Nothing
next

【ドロップされたファイルまたはフォルダのパスを配列に取得】

'----------------
'ドロップされたファイルまたはフォルダのパスを配列に取得
'----------------
Set myArray = WScript.Arguments
'配列の内容を出力 フルパス
For Each pass_str in myArray
	MsgBox(pass_str)
Next

【フォルダ内のPDFファイル数をカウントする】

Option Explicit
 
Dim args
Dim f
Dim cntPDF
Dim cntOthers
 
'初期化
cntPDF		= 0
cntOthers	= 0
 
Set args = WScript.Arguments
'パラメータ数チェック
If args.Count < 1 Then
  WScript.Echo "当スクリプトにフォルダをドラッグ&ドロップして処理を実行してください。"
  WScript.Quit
End If
 
With CreateObject("Scripting.FileSystemObject")
  If Not .FolderExists(args(0)) Then
    WScript.Echo "フォルダが見つかりません。" & vbCrLf & "あるいはフォルダではありません。"
    WScript.Quit
  Else
    For Each f In .GetFolder(args(0)).Files
      Select Case LCase(.GetExtensionName(f.Path))
        Case "pdf":		cntPDF		= cntPDF	+ 1
		Case Else:		cntOthers	= cntOthers + 1
      End Select
    Next
  End If
End With
 
MsgBox "PDFファイル数は" & cntPDF & "です。" & vbCr & "それ以外は" & cntOthers & "です。", vbInformation + vbSystemModalEmy

【フォルダ内のPDFファイル数を結合する】

'**********************************************
' Acrobatを使ってフォルダ内のPDFファイルを結合するVBScript
'**********************************************
Option Explicit
 
Dim args
Dim f,n,ts,fp,fso,pdoc
Dim cntPDF
Dim cntOthers
Dim fn
 
'初期化
cntPDF					= 0
cntOthers				= 0
Const PDSaveFull		= 1
Const OutputFileName	= "merged_" 					'結合後のファイル名
 
Set args = WScript.Arguments
'パラメータ数チェック
If args.Count < 1 Then
	WScript.Echo "当スクリプトにフォルダをドラッグ&ドロップして処理を実行してください。"
	WScript.Quit
End If
 
Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FolderExists(args(0)) Then
	WScript.Echo "フォルダが見つかりません。" & vbCrLf & "あるいはフォルダではありません。"
	WScript.Quit
Else
  	'出力先設定
	n	= Now()
	ts	= Year(n) & Right("0" & Month(n), 2) & Right("0" & Day(n), 2) & Right("0" & Hour(n), 2) & Right("0" & Minute(n), 2) & Right("0" & Second(n), 2)
	fp	= fso.BuildPath(fso.GetFolder(args(0)).Path, OutputFileName & ts & ".pdf")
	With CreateObject("AcroExch.PDDoc")
		If .Create = True Then
			Set pdoc = CreateObject("AcroExch.PDDoc")
			'フォルダ内のファイルを一つ一つ確認する
		    For Each f In fso.GetFolder(args(0)).Files
		    	'拡張子を確認する
				Select Case LCase(fso.GetExtensionName(f.Path))
					Case "pdf":
						cntPDF = cntPDF + 1
						If pdoc.Open(f) = True Then
							.InsertPages .GetNumPages() - 1, pdoc, 0, pdoc.GetNumPages() - 1, True
							pdoc.Close
						End If
					Case Else:		cntOthers	= cntOthers + 1
				End Select
			Next
			.Save PDSaveFull, fp
			.Close
		End if
	End With
End If
 
MsgBox "結合ファイルを作成しました。"& vbCrLf &"PDFファイル数は" & cntPDF & "です。", vbInformation + vbSystemModal

戯言(nonsense)に戻る

免責事項

本ソフトウエアは、あなたに対して何も保証しません。本ソフトウエアの関係者（他の利用者も含む）は、あなたに対して一切責任を負いません。
あなたが、本ソフトウエアを利用（コンパイル後の再利用など全てを含む）する場合は、自己責任で行う必要があります。

本ソフトウエアの著作権はToolsBoxに帰属します。
本ソフトウエアをご利用の結果生じた損害について、ToolsBoxは一切責任を負いません。
ToolsBoxはコンテンツとして提供する全ての文章、画像等について、内容の合法性・正確性・安全性等、において最善の注意をし、作成していますが、保証するものではありません。
ToolsBoxはリンクをしている外部サイトについては、何ら保証しません。
ToolsBoxは事前の予告無く、本ソフトウエアの開発・提供を中止する可能性があります。

商標・登録商標

Microsoft、Windows、WindowsNTは米国Microsoft Corporationの米国およびその他の国における登録商標です。
Windows　Vista、Windows　XPは、米国Microsoft Corporation.の商品名称です。
LabVIEW、National Instruments、NI、ni.comはNational Instrumentsの登録商標です。
I2Cは、NXP Semiconductors社の登録商標です。
その他の企業名ならびに製品名は、それぞれの会社の商標もしくは登録商標です。
すべての商標および登録商標は、それぞれの所有者に帰属します。