Option Explicit

Dim hozonsaki, filesousa, insuu, i
Dim formatChoice, ext

'==================== 定数 ====================
' Word
Const wdExportFormatPDF = 17
Const wdExportFormatXPS = 18
Const wdFormatRTF = 6
Const wdFormatXML = 11
Const wdDoNotSaveChanges = 0
Const wdFormatOpenDocumentText = 23
Const wdFormatHTML = 8
Const wdFormatWebArchive = 9
Const wdFormatDocument = 0
Const wdFormatDocumentDefault = 12

' Excel
Const xlTypePDF = 0
Const xlTypeXPS = 1
Const xlXMLSpreadsheet = 46
Const xlOpenDocumentSpreadsheet = 60
Const xlHtml = 44
Const xlCSV = 6
Const xlWebArchive = 45
Const xlWorkbookNormal = -4143
Const xlOpenXMLWorkbook = 51

' PowerPoint
Const ppSaveAsPDF = 32
Const ppSaveAsXPS = 64
Const ppSaveAsPNG = 18
Const ppSaveAsJPG = 17
Const ppSaveAsSVG = 11
Const ppSaveAsXML = 43
Const ppSaveAsRTF = 6
Const ppSaveAsODP = 35
Const ppSaveAsPresentation = 1
Const ppSaveAsOpenXMLPresentation = 24

'==================== 初期設定 ====================
Set filesousa = CreateObject("Scripting.FileSystemObject")
Set insuu = WScript.Arguments

If insuu.Count < 1 Then
  MsgBox "このスクリプトにファイルをドラッグして使ってください。", vbExclamation + vbSystemModal
  WScript.Quit
End If

'==================== 出力形式選択 ====================
formatChoice = InputBox( _
  "出力形式を選択してください:" & vbCrLf & _
  "1 = PDF" & vbCrLf & _
  "2 = XPS" & vbCrLf & _
  "3 = XML" & vbCrLf & _
  "4 = OpenDocument" & vbCrLf & _
  "5 = Office 97-2003" & vbCrLf & _
  "6 = Office 2007" & vbCrLf & _
  "7 = RTF (Word/PowerPoint)" & vbCrLf & _
  "8 = HTML (Word/Excel)" & vbCrLf & _
  "9 = MHTML (Word/Excel)" & vbCrLf & _
  "10 = CSV (Excelのみ)" & vbCrLf & _
  "11 = SVG (PowerPointのみ)" & vbCrLf & _
  "12 = PNG (PowerPointのみ)" & vbCrLf & _
  "13 = JPEG (PowerPointのみ", _
  "出力形式を選択してください", "1")

If formatChoice = "" Then WScript.Quit

Select Case CInt(formatChoice)
  Case 1: ext = ".pdf"
  Case 2: ext = ".xps"
  Case 3: ext = ".xml"
  Case 4: ext = ".od*"
  Case 5: ext = ".03"
  Case 6: ext = ".07"
  Case 7: ext = ".rtf"
  Case 8: ext = ".htm"
  Case 9: ext = ".mht"
  Case 10: ext = ".csv"
  Case 11: ext = ".svg"
  Case 12: ext = ".png"
  Case 13: ext = ".jpg"
  Case Else
    MsgBox "不正な選択です。", vbCritical
    WScript.Quit
End Select

'==================== ファイル処理 ====================
For i = 0 To insuu.Count - 1

  Dim baseFolder
  baseFolder = filesousa.GetParentFolderName(insuu(i))
  Dim baseName
  baseName = filesousa.GetBaseName(insuu(i))
  
  hozonsaki = baseFolder & "\" & baseName & Replace(ext, "*", "")

  Select Case LCase(filesousa.GetExtensionName(insuu(i)))

    '================= Word =================
    Case "doc","docx","docm","dot","dotx","dotm","odt"
      Dim w
      Set w = CreateObject("Word.Application")
      w.Visible = False

      With w.Documents.Open(insuu(i))
        Select Case CInt(formatChoice)
          Case 1: .ExportAsFixedFormat hozonsaki, wdExportFormatPDF
          Case 2: .ExportAsFixedFormat hozonsaki, wdExportFormatXPS
          Case 3: .SaveAs2 hozonsaki, wdFormatXML
          Case 4
            hozonsaki = Replace(hozonsaki, ".od", ".odt")
            .SaveAs2 hozonsaki, wdFormatOpenDocumentText
          Case 5
            hozonsaki = Replace(hozonsaki, ".03", ".doc")
            .SaveAs2 hozonsaki, wdFormatDocument
          Case 6
            hozonsaki = Replace(hozonsaki, ".07", ".docx")
            .SaveAs2 hozonsaki, wdFormatDocumentDefault
          Case 7: .SaveAs2 hozonsaki, wdFormatRTF
          Case 8: .SaveAs2 hozonsaki, wdFormatHTML
          Case 9: .SaveAs2 hozonsaki, wdFormatWebArchive
          Case Else
            MsgBox "Word はこの形式に対応していません: " & ext
        End Select
        .Close wdDoNotSaveChanges
      End With
      w.Quit

    '================= Excel =================
    Case "xls","xlsx","xlsm","xlsb","xlt","xltx","xltm","ods"
      Dim x
      Set x = CreateObject("Excel.Application")
      x.Visible = False

      With x.Workbooks.Open(insuu(i))
        Select Case CInt(formatChoice)
          Case 1: .ExportAsFixedFormat xlTypePDF, hozonsaki
          Case 2: .ExportAsFixedFormat xlTypeXPS, hozonsaki
          Case 3: .SaveAs hozonsaki, xlXMLSpreadsheet
          Case 4
            hozonsaki = Replace(hozonsaki, ".od", ".ods")
            .SaveAs hozonsaki, xlOpenDocumentSpreadsheet
          Case 5
            hozonsaki = Replace(hozonsaki, ".03", ".xls")
            .SaveAs hozonsaki, xlWorkbookNormal
          Case 6
            hozonsaki = Replace(hozonsaki, ".07", ".xlsx")
            .SaveAs hozonsaki, xlOpenXMLWorkbook
          Case 8: .SaveAs hozonsaki, xlHtml
          Case 9: .SaveAs hozonsaki, xlWebArchive
          Case 10: .SaveAs hozonsaki, xlCSV
          Case Else
            MsgBox "Excel はこの形式に対応していません: " & ext
        End Select
        .Close False
      End With
      x.Quit

    '================= PowerPoint =================
    Case "ppt","pptx","pptm","pot","potx","potm","odp"
      Dim p
      Set p = CreateObject("PowerPoint.Application")
      p.Visible = True

      With p.Presentations.Open(insuu(i))

        Dim slideFolder
        If CInt(formatChoice) = 12 Or CInt(formatChoice) = 13 Then
            slideFolder = baseFolder & "\" & baseName & "_スライド"
            If Not filesousa.FolderExists(slideFolder) Then
                filesousa.CreateFolder(slideFolder)
            End If
        End If

        Select Case CInt(formatChoice)
          Case 1: .SaveAs hozonsaki, ppSaveAsPDF
          Case 2: .SaveAs hozonsaki, ppSaveAsXPS
          Case 3: .SaveAs hozonsaki, ppSaveAsXML
          Case 4
            hozonsaki = Replace(hozonsaki, ".od", ".odp")
            .SaveAs hozonsaki, ppSaveAsODP
          Case 5
            hozonsaki = Replace(hozonsaki, ".03", ".ppt")
            .SaveAs hozonsaki, ppSaveAsPresentation
          Case 6
            hozonsaki = Replace(hozonsaki, ".07", ".pptx")
            .SaveAs hozonsaki, ppSaveAsOpenXMLPresentation
          Case 7: .SaveAs hozonsaki, ppSaveAsRTF
          Case 11: .SaveAs hozonsaki, ppSaveAsSVG
          Case 12: .SaveAs slideFolder , ppSaveAsPNG
          Case 13: .SaveAs slideFolder , ppSaveAsJPG
          Case Else
            MsgBox "PowerPoint はこの形式に対応していません: " & ext
        End Select
        .Close
      End With
      p.Quit

  End Select
Next

MsgBox "変換完了！", vbInformation + vbSystemModal