トップページ > その他 > ドラッグ&ドロップで各種ファイルをPDFに変換する(VBS)

ドラッグ&ドロップで各種ファイルをPDFに変換する(VBS)

ドラッグ&ドロップで各種ファイルをPDFに変換するVBScriptです。
※ 要Acrobat


                    Option Explicit

                    

                    Dim Arg, Args

                    Dim InputPath, OutputPath

                    Const MsgTitle = "PDF変換スクリプト"

                    

                    Set Args = WScript.Arguments

                    If Args.Count < 1 Then

                      MsgBox "PDFに変換したいファイルを当スクリプトファイルに" & vbCrLf & _

                             "ドラッグ&ドロップして処理を実行してください。", 16, MsgTitle

                      WScript.Quit

                    End If

                    For Each Arg In Args

                      InputPath = Arg

                      OutputPath = Left(InputPath, InStrRev(InputPath, ".")) & "pdf"

                      SavePDF InputPath, OutputPath 'PDFに変換

                    Next

                    Set Args = Nothing

                    MsgBox "処理が終了しました。", 64, MsgTitle

                    

                    Private Sub SavePDF(ByVal InputPath, ByVal OutputPath)

                      Dim app, pddoc, avdoc

                      

                      On Error Resume Next

                      Set app = CreateObject("AcroExch.App")

                      Set avdoc = CreateObject("AcroExch.AVDoc")

                      If avdoc.Open(InputPath, "") = True Then

                        app.Show 'アプリケーション表示

                        Set pddoc = avdoc.GetPDDoc

                        'Saveメソッドの第一引数は適当に変更

                        If pddoc.Save(1, OutputPath) = True Then

                          '終了処理

                          app.CloseAllDocs

                          app.Hide

                          app.Exit

                        End If

                        Set pddoc = Nothing

                      End If

                      Set avdoc = Nothing

                      Set app = Nothing

                      If Err.Number <> 0 Then

                        MsgBox "エラーが発生しました。" & vbCrLf & "エラー内容 : " & Err.Description, 16, MsgTitle

                        Err.Clear

                        Exit Sub

                      End If

                      On Error GoTo 0

                    End Sub