フォルダ内にあるＰＤＦをサブフォルダを含めて全て印刷

t=t&"ドロップでＰＤＦを印刷する　　　 　　　　　　　" & vbNewLine
t=t&"-------------------------------------------------" & vbNewLine
t=t&"フォルダ内にあるＰＤＦをサブフォルダを含めて 　 " & vbNewLine
t=t&"全て印刷します。 　　　　　　 " & vbNewLine
t=t&"標準のプリンタに印刷します　　　　　　　　　　　 " & vbNewLine
t=t&"　　　 " & vbNewLine
t=t&" 2009/9/21 Ver1.0 　　　 " & vbNewLine
t=t&" " & vbNewLine
t=t&"※大量に処理すると印刷されないものが出てきます " & vbNewLine
t=t&"　AcrobatReaderV9.1からはこの問題が出ないようです" & vbNewLine

TargetExt = "pdf"


'------------------------------
' ファイルの実行
'------------------------------
Sub Execfile(File)
File=objFS.GetFile(File).Path
Set objExec=objShell.Exec(""""&Path&""" /n /t """&File&"""")
Do While objExec.Status=0
WScript.Sleep 100
Loop
set objExec = Nothing

End Sub


'---------------------------------------
'プログラム自体はここからスタート
'---------------------------------------
If WScript.Arguments.Count > 0 Then

Set objShell = WScript.CreateObject("WScript.Shell")
If objShell.Popup("３秒後に自動的に実行します",3,WScript.ScriptName,1)<>2 Then

' Set xlApp = WScript.CreateObject("Excel.Application")
' xlApp.Visible = False
' xlApp.ScreenUpdating = False
' xlApp.DisplayAlerts = False
' xlApp.Options.UpdateLinksAtOpen = False
Set objFS = CreateObject("Scripting.FileSystemObject")

Path=objShell.RegRead("HKLM\Software\Microsoft\Windows\CurrentVersion\App Paths\acrord32.exe\")
Path=Replace(Path,"""","")
Path=objShell.ExpandEnvironmentStrings(Path)
Set pExec=objShell.Exec(""""&Path&""" /n /h""")
Do While Not objShell.AppActivate(pExec.ProcessID)
WScript.Sleep 100
Loop
WScript.Sleep 4000

For Each PathName in WScript.Arguments
Call Main(PathName)
Next
'If pExec.Status=0 Then pExec.Terminate
call objShell.Popup(WScript.ScriptName & vbNewLine & "【実行完了】" & vbNewLine & vbNewLine & "30秒後に自動的に閉じます",30)
' xlApp.Quit
Set xlApp = Nothing
Set objFS = Nothing
Else
call objShell.Popup("実行せずに終了しました" & vbNewLine & vbNewLine & "30秒後に自動的に閉じます",30)
End If

Else
WScript.Echo t
End If

' xlApp.Quit
' Set xlApp = Nothing
' Set objFS = Nothing

WScript.Quit

'---------------------------------------

Sub Main(ByVal objPath)
' Dim objFS,objFolder
Dim objFolder

' Set objFS = CreateObject("Scripting.FileSystemObject")
If objFS.FolderExists(objPath) Then
Set objFolder = objFS.GetFolder(objPath)
Call PathAll(objFolder)
ElseIf objFS.FileExists(objPath) Then
Call OneFile(objPath)
End If
' Set objFS = Nothing

End Sub
'------------------------------------------------
' ファイルならファイル処理。フォルダなら再帰処理
'------------------------------------------------
Sub PathAll(ByVal objFolder)
Dim objFile,files
Set files = objFolder.Files
For Each objFile In files
Call OneFile(objFile.Path)
Next
Dim subfolders,objSub
Set subfolders = objFolder.SubFolders
For Each objSub In subfolders
Call PathAll(objSub)
Next
End Sub
'------------------------------------------------
' 指定拡張子のファイルのみを抽出
'------------------------------------------------
Sub OneFile(ByVal file)
ext = objFS.GetExtensionName(file)
If ext = TargetExt Then
Execfile(file)
End If
End Sub