Option Explicit
 Dim strFileName, objFile,strErrFile

 If WScript.Arguments.Count=0 Then
     MsgBox "MS Officeファイルをドラッグしてください。" & vbCrLf & _
            "PDFに変換します" & vbCrLf & _
            " ※複数のファイルをドラッグしてもOKです"
     WScript.Quit
 End If
    
 strErrFile=Null
 On Error Resume Next
 For Each strFileName In Wscript.Arguments
     Set objFile = GetObject(strFileName)
    
     '必要に応じて拡張子を追加して下さい
     select case getExtName(strFileName)
     case "doc","docx"
         objFile.SaveAs GetFNameFromFStr(objFile.FullName)+".pdf", 17
     case "ppt","pptx"
         objFile.SaveAs GetFNameFromFStr(objFile.FullName)+".pdf", 32
     case "xls","xlsx","xlsm"
         objFile.ExportAsFixedFormat 0,GetFNameFromFStr(objFile.FullName)+".pdf"
     case else 
         strErrFile = strErrFile & vbcrlf & strFileName
     End Select
     objFile.Close
 Next
 On Error Goto 0

 if Not Isnull(strErrFile) Then
     Wscript.Echo "変換完了" & vbcrlf & vbcrlf & "以下のファイルは変換対象外です。" & vbcrlf & strErrFile 
 else 
     Wscript.Echo "変換完了" 
 end if

 '-------------------------------------------------------------------
 Function GetFNameFromFStr(sFileName )
     Dim sFileStr' As String
     Dim lFindPoint 'As Long
     Dim lStrLen' As Long
     lFindPoint = InStrRev(sFileName, ".")
     sFileStr = Left(sFileName, lFindPoint - 1)
     GetFNameFromFStr = sFileStr
 End Function

 '-------------------------------------------------------------------
 Function getExtName(getPath)
     Dim objFSO
     set objFSO = CreateObject("Scripting.FileSystemObject")
     '拡張子を取得する
     getExtName = objFSO.GetextensionName(getPath)
 End Function