LibreOffice7.6 calcのマクロについて

Question

【実現したいこと】
①ユーザーにフォルダパスとキーワードの入力を求める。
②指定のフォルダを開き、フォルダの中に入っているファイルを開き、
ファイル内に指定のキーワードが含まれているか確認。
③含まれていたら別でまとめて書き出す。

【質問内容】
ChatGPTでOpenOffice Basicで【実現したいこと】の内容でマクロを組んでもらいました。
結果は以下の【ソースコード】に記載してます。
【ソースコード】の内容でマクロを実行したら、エラーは表示されず完了できるのですが、
指定したキーワードが含まれているはずなのに、結果ファイルの生成がされないと思ってまして…
Cドライブ直下にtestというフォルダを作成し、その中に「1,2,3,11」と4つのテキストファイルを作成しました。
テキストの中身の内容も「1,2,3,11」と同じにしてます。
マクロを実行し、パスは「C:\test」、キーワードは「1」、結果の保存先のパスを「C:\test\result」にしてOKをして
「検索が完了しました。」と表示後、「C:\test\result」の中に指定したキーワードが含まれていれば
ファイルが生成される認識だったのですが、何も生成されなくて…
どう修正したら良いでしょうか。

【ソースコード】

Option VBASupport 1

Sub SearchFilesForKeyword()
    Dim sFolderPath As String
    Dim sKeyword As String
    Dim sResultPath As String
    Dim oFileSystem As Object
    Dim oFolder As Object
    Dim oFile As Object
    Dim oTextFile As Object
    Dim sFileContents As String
    
    ' ユーザーにフォルダパスの入力を求める
    sFolderPath = InputBox("検索するフォルダのパスを入力してください:", "フォルダパスの入力")
    If sFolderPath = "" Then Exit Sub ' キャンセルされた場合は終了
    
    ' ユーザーにキーワードの入力を求める
    sKeyword = InputBox("検索するキーワードを入力してください:", "キーワードの入力")
    If sKeyword = "" Then Exit Sub ' キャンセルされた場合は終了
    
    ' ユーザーに結果の保存先のパスの入力を求める
    sResultPath = InputBox("結果の保存先のパスを入力してください:", "結果保存先のパスの入力")
    If sResultPath = "" Then Exit Sub ' キャンセルされた場合は終了
    
    ' フォルダが存在するか確認
    Set oFileSystem = CreateObject("Scripting.FileSystemObject")
    If Not oFileSystem.FolderExists(sFolderPath) Then
        MsgBox "指定されたフォルダが見つかりません。", vbExclamation, "エラー"
        Exit Sub
    End If
    
    ' フォルダを開く
    Set oFolder = oFileSystem.GetFolder(sFolderPath)
    
    ' フォルダ内のファイルを検索
    For Each oFile In oFolder.Files
        ' テキストファイルのみ処理
        If LCase(Right(oFile.Name, 4)) = ".txt" Then
            ' ファイルを開く
            Set oTextFile = oFileSystem.OpenTextFile(oFile.Path, 1)
            sFileContents = oTextFile.ReadAll
            oTextFile.Close
            
            ' キーワードが含まれるかチェック
            If InStr(1, sFileContents, sKeyword, vbTextCompare) > 0 Then
                ' キーワードが含まれている場合は結果ファイルに書き出す
                Dim oResultFile As Object
                Set oResultFile = oFileSystem.OpenTextFile(sResultPath & "\" & oFile.Name, 8, True)
                oResultFile.Write sFileContents
                oResultFile.Close
            End If
        End If
    Next oFile
    
    MsgBox "検索が完了しました。", vbInformation, "完了"
    
End Sub

Answer 1

どうやら、Scripting.FileSystemObjectがCalcのスクリプトでは、完全に使えるわけではないようですね。

ChatGPTに聞くときに「Scripting.FileSystemObject」を使わない方法で。という条件を付けたりしたらいいのかもしれませんね。

また、使える部分だけ使うように修正するのも、可能ではあると思います。
試しでファイル名の取得をDir関数に置き換えてみました。

    strResult = Dir(oFileSystem.BuildPath(sFolderPath,"*.*"))
    Do While strResult <> ""
        Set oFile=oFileSystem.GetFile(oFileSystem.BuildPath(sFolderPath,strResult))

        ' テキストファイルのみ処理
        If LCase(Right(oFile.Name, 4)) = ".txt" Then
            ' ファイルを開く
            Set oTextFile = oFileSystem.OpenTextFile(oFile.Path, 1)
            sFileContents = oTextFile.ReadAll
            oTextFile.Close
            
            ' キーワードが含まれるかチェック
            If InStr(1, sFileContents, sKeyword, vbTextCompare) > 0 Then
                ' キーワードが含まれている場合は結果ファイルに書き出す
                Dim oResultFile As Object
                Set oResultFile = oFileSystem.OpenTextFile(sResultPath & "\" & oFile.Name, 8, True)
                oResultFile.Write sFileContents
                oResultFile.Close
            End If
        End If

        strResult = Dir()
    Loop

一応動きはしました。