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

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

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

【ソースコード】

OpenOffice

1Option VBASupport 1 2 3Sub SearchFilesForKeyword() 4 Dim sFolderPath As String 5 Dim sKeyword As String 6 Dim sResultPath As String 7 Dim oFileSystem As Object 8 Dim oFolder As Object 9 Dim oFile As Object 10 Dim oTextFile As Object 11 Dim sFileContents As String 12 13 ' ユーザーにフォルダパスの入力を求める 14 sFolderPath = InputBox("検索するフォルダのパスを入力してください:", "フォルダパスの入力") 15 If sFolderPath = "" Then Exit Sub ' キャンセルされた場合は終了 16 17 ' ユーザーにキーワードの入力を求める 18 sKeyword = InputBox("検索するキーワードを入力してください:", "キーワードの入力") 19 If sKeyword = "" Then Exit Sub ' キャンセルされた場合は終了 20 21 ' ユーザーに結果の保存先のパスの入力を求める 22 sResultPath = InputBox("結果の保存先のパスを入力してください:", "結果保存先のパスの入力") 23 If sResultPath = "" Then Exit Sub ' キャンセルされた場合は終了 24 25 ' フォルダが存在するか確認 26 Set oFileSystem = CreateObject("Scripting.FileSystemObject") 27 If Not oFileSystem.FolderExists(sFolderPath) Then 28 MsgBox "指定されたフォルダが見つかりません。", vbExclamation, "エラー" 29 Exit Sub 30 End If 31 32 ' フォルダを開く 33 Set oFolder = oFileSystem.GetFolder(sFolderPath) 34 35 ' フォルダ内のファイルを検索 36 For Each oFile In oFolder.Files 37 ' テキストファイルのみ処理 38 If LCase(Right(oFile.Name, 4)) = ".txt" Then 39 ' ファイルを開く 40 Set oTextFile = oFileSystem.OpenTextFile(oFile.Path, 1) 41 sFileContents = oTextFile.ReadAll 42 oTextFile.Close 43 44 ' キーワードが含まれるかチェック 45 If InStr(1, sFileContents, sKeyword, vbTextCompare) > 0 Then 46 ' キーワードが含まれている場合は結果ファイルに書き出す 47 Dim oResultFile As Object 48 Set oResultFile = oFileSystem.OpenTextFile(sResultPath & "\" & oFile.Name, 8, True) 49 oResultFile.Write sFileContents 50 oResultFile.Close 51 End If 52 End If 53 Next oFile 54 55 MsgBox "検索が完了しました。", vbInformation, "完了" 56 57End Sub

コメントを投稿

0 コメント