PAD:ファイルをインプットにしたAI返答取得フロー

SET FilePath TO $'''テストファイルのフルパスを記載（\"\"は不要）'''
Scripting.RunVBScript.RunVBScript VBScriptCode: $'''Option Explicit

\'=========================
\' 設定（ここを書き換える）
\'=========================
Const BR = \"\\r\\n\"   \' API用 改行置換文字

Dim targetPath
targetPath = \"%FilePath%\"
\' 例:
\' targetPath = \"C:\\test\\sample.xlsx\"
\' targetPath = \"C:\\test\\sample.pptx\"
\' targetPath = \"C:\\test\\sample.txt\"


\'=========================
\' メイン
\'=========================
Dim resultText
resultText = ExtractText(targetPath)
resultText = SafeForAPI(resultText)
WScript.Echo resultText


\'=========================
\' 共通：拡張子判定 → 抽出
\'=========================
Function ExtractText(path)
    Dim fso, ext, text
    Set fso = CreateObject(\"Scripting.FileSystemObject\")

    If Not fso.FileExists(path) Then
        ExtractText = \"ERROR: ファイルが存在しません\"
        Exit Function
    End If

    ext = LCase(fso.GetExtensionName(path))

    Select Case ext
        Case \"doc\", \"docx\"
            text = GetTextFromWord(path)

        Case \"xls\", \"xlsx\"
            text = GetTextFromExcel(path)

        Case \"ppt\", \"pptx\"
            text = GetTextFromPPT(path)

        Case \"txt\"
            text = GetTextFromTxt(path)

        Case Else
            text = \"ERROR: 未対応形式 (\" & ext & \")\"
    End Select

    ExtractText = NormalizeText(text)
End Function


\'=========================
\' 改行正規化（API向け）
\'=========================
Function NormalizeText(str)
    If IsNull(str) Or str = \"\" Then
        NormalizeText = \"\"
        Exit Function
    End If

    str = Replace(str, vbCrLf, BR)
    str = Replace(str, vbCr, BR)
    str = Replace(str, vbLf, BR)

    NormalizeText = str
End Function


\'=========================
\' Word
\'=========================
Function GetTextFromWord(path)
    Dim app, doc

    Set app = CreateObject(\"Word.Application\")
    app.Visible = False

    Set doc = app.Documents.Open(path, False, True)
    GetTextFromWord = doc.Content.Text

    doc.Close False
    app.Quit
End Function


\'=========================
\' Excel（全シート・全セル）
\'=========================
Function GetTextFromExcel(path)
    Dim app, book, sheet, cell
    Dim result

    result = \"\"

    Set app = CreateObject(\"Excel.Application\")
    app.Visible = False
    app.DisplayAlerts = False

    Set book = app.Workbooks.Open(path)

    For Each sheet In book.Worksheets
        result = result & \"【Sheet:\" & sheet.Name & \"】\" & vbCrLf

        For Each cell In sheet.UsedRange
            If Trim(cell.Value & \"\") <> \"\" Then
                result = result & cell.Value & vbCrLf
            End If
        Next
    Next

    book.Close False
    app.Quit

    GetTextFromExcel = result
End Function


\'=========================
\' PowerPoint（全スライド）
\'=========================
Function GetTextFromPPT(path)
    Dim app, pres, slide, shape
    Dim result

    result = \"\"

    Set app = CreateObject(\"PowerPoint.Application\")
    app.Visible = False

    Set pres = app.Presentations.Open(path, False, False, False)

    For Each slide In pres.Slides
        result = result & \"【Slide \" & slide.SlideIndex & \"】\" & vbCrLf

        For Each shape In slide.Shapes
            If shape.HasTextFrame Then
                If shape.TextFrame.HasText Then
                    result = result & shape.TextFrame.TextRange.Text & vbCrLf
                End If
            End If
        Next
    Next

    pres.Close
    app.Quit

    GetTextFromPPT = result
End Function


\'=========================
\' TXT
\'=========================
Function GetTextFromTxt(path)
    Dim fso, ts
    Set fso = CreateObject(\"Scripting.FileSystemObject\")
    Set ts = fso.OpenTextFile(path, 1, False)

    GetTextFromTxt = ts.ReadAll
    ts.Close
End Function

Function SafeForAPI(str)
    Dim i, ch, code, result
    result = \"\"

    For i = 1 To Len(str)
        ch = Mid(str, i, 1)
        code = AscW(ch)

        \' 制御文字を除外（改行は事前に置換済み前提）
        If code = 9 Then
            result = result & \" \"          \' TAB → 空白
        ElseIf code = 160 Then
            result = result & \" \"          \' NBSP → 空白
        ElseIf code < 32 Then
            \' NULL, BEL, その他制御文字は捨てる
        Else
            result = result & ch
        End If
    Next

    \' 連続スペースを圧縮
    Do While InStr(result, \"  \") > 0
        result = Replace(result, \"  \", \" \")
    Loop

    SafeForAPI = result
End Function

''' ScriptOutput=> FileInput
Text.Replace Text: FileInput TextToFind: $'''\\r\\n''' IsRegEx: True IgnoreCase: False ReplaceWith: $'''\\n''' ActivateEscapeSequences: False Result=> FileInput
Display.InputDialog Title: $'''プロンプトを入力してください''' InputType: Display.InputType.SingleLine IsTopMost: False UserInput=> UserPrompt ButtonPressed=> ButtonPressed2
SET UserInput TO $'''%UserPrompt%%FileInput%'''
SET APIKey TO $'''APIキーを記載'''
Web.InvokeWebService.InvokeWebServicePost Url: $'''https://api.openai.com/v1/chat/completions''' Accept: $'''application/json''' ContentType: $'''application/json''' CustomHeaders: $'''Authorization: Bearer %APIKey%''' RequestBody: $'''{
  \"model\": \"gpt-3.5-turbo\",
  \"messages\": [{\"role\": \"user\", \"content\": \"%UserInput%\"}],
  \"temperature\": 0.7
}''' ConnectionTimeout: 30 FollowRedirection: True ClearCookies: False FailOnErrorStatus: False EncodeRequestBody: False UserAgent: $'''Mozilla/5.0 (Windows; U; Windows NT 5.1; en-US; rv:1.8.1.21) Gecko/20100312 Firefox/3.6''' Encoding: Web.Encoding.AutoDetect AcceptUntrustedCertificates: False TrimRequestBody: True ResponseHeaders=> WebServiceResponseHeaders Response=> WebServiceResponse StatusCode=> StatusCode
Variables.ConvertJsonToCustomObject Json: WebServiceResponse CustomObject=> JsonAsCustomObject
Display.ShowMessageDialog.ShowMessage Title: $'''ChatGPTの返答''' Message: JsonAsCustomObject.choices[0].message.content Icon: Display.Icon.None Buttons: Display.Buttons.OK DefaultButton: Display.DefaultButton.Button1 IsTopMost: False ButtonPressed=> ButtonPressed