LibreOffice7.6 calcのマクロ

マクロ初心者なので、ChatGPTで言語をOpenOffice Basicに指定してマクロを組んでもらいました。
そのコードをLibreOffice7.6で実行すると「For Each file In files」の部分で、
「許可されない値またはデータ型.データの種類が一致していません。」というエラーが表示されました。
どう修正したら良いでしょうか。

「組んだ内容」
①ユーザーにフォルダパスとキーワードの入力を求める。
②フォルダ内のファイルを取得して、キーワードが含まれているか確認。
③含まれていたら、新規ファイル作成してそこに抽出する。

「コード」
Sub SearchAndExtractFiles()
Dim folderPath As String
Dim keyword As String
Dim foundFiles() As String
Dim foundCount As Integer
Dim i As Integer

' ユーザーからフォルダパスの入力を求める
folderPath = InputBox("フォルダパスを入力してください", "フォルダパスの入力")
If folderPath = "" Then
    MsgBox "フォルダパスが入力されていません。", vbExclamation
    Exit Sub
End If

' ユーザーからキーワードの入力を求める
keyword = InputBox("検索するキーワードを入力してください", "キーワードの入力")
If keyword = "" Then
    MsgBox "キーワードが入力されていません。", vbExclamation
    Exit Sub
End If

' フォルダ内のファイルを検索して、キーワードが含まれているファイルを抽出
foundCount = 0
Call SearchFilesInFolder(folderPath, keyword, foundFiles, foundCount)

' キーワードが含まれているファイルがあれば、新規ファイルに抽出する
If foundCount > 0 Then
    Dim outputFilePath As String
    outputFilePath = folderPath & "\ExtractedFiles.txt"
    
    Dim outputFile As Object
    outputFile = FreeFile()
    Open outputFilePath For Output As outputFile
    
    For i = 1 To foundCount
        Print #outputFile, foundFiles(i)
    Next i
    
    Close outputFile
    MsgBox "キーワードが含まれているファイルが見つかりました。" & Chr(10) & "抽出されたファイルは " & outputFilePath & " に保存されました。", vbInformation
Else
    MsgBox "キーワードが含まれているファイルは見つかりませんでした。", vbInformation
End If

End Sub

Sub SearchFilesInFolder(folderPath As String, keyword As String, ByRef foundFiles() As String, ByRef foundCount As Integer)
Dim files As Object
Dim file As Object
Dim fileName As String

files = CreateObject("Scripting.FileSystemObject").GetFolder(folderPath).Files

For Each file In files
    fileName = file.Name
    If InStr(1, fileName, keyword, vbTextCompare) > 0 Then
        foundCount = foundCount + 1
        ReDim Preserve foundFiles(foundCount)
        foundFiles(foundCount) = fileName
    End If
Next file

End Sub

メモ

https://bugs.documentfoundation.org/show_bug.cgi?id=118241

1 Like

ChatGPTにLibreOfficeBasicで
CreateObject(“Scripting.FileSystemObject”)
はどのような働きをしますか?と問い合わせた回答です

’CreateObject("Scripting.FileSystemObject")’ は、MicrosoftのVBScriptやVBAなどのスクリプト言語で使用される方法で、ファイルやフォルダの操作を行うためのオブジェクトを作成します。このオブジェクトは、ファイルの読み書き、フォルダの作成や削除、ファイルのプロパティの取得など、ファイルシステムに関連する様々な操作を行うために使用されます。

しかし、LibreOffice Basicでは、このような直接的な方法はサポートされていません。LibreOffice Basicでは、代わりにLibreOfficeが提供するAPIを使用します。ファイルやフォルダの操作を行うためには、com.sun.star.ucb.SimpleFileAccess サービスを使用します。

とのことで提示されたコードで試したら

outputFile = FreeFile()

のところで止まりました
FreeFile()ってなんだというのをchatGPTに問いかけてみては?

1 Like

Claude.ai(Opus)でどんな回答がでるか試してみようと「SearchFilesInFolder」の問題箇所、問い合わせしました所、
「LibreOffice Basic では、Scripting.FileSystemObject を使用することができません。 Dir 関数を使用してフォルダ内のファイルを取得する必要があります」というメッセージとともに、以下のようなコードが出てきました。

Sub SearchFilesInFolder(folderPath As String, keyword As String, ByRef foundFiles() As String, ByRef foundCount As Integer)
    Dim fileName As String    
    ' フォルダ内のファイルを取得
    fileName = Dir(folderPath & "/*.*")
    
    Do While fileName <> ""
        ' ファイル名にキーワードが含まれているかチェック
        If InStr(1, fileName, keyword, vbTextCompare) > 0 Then
            foundCount = foundCount + 1
            ReDim Preserve foundFiles(foundCount)
            foundFiles(foundCount) = fileName
        End If
     
        ' 次のファイルを取得
        fileName = Dir
    Loop
End Sub

sabr0さんと同様に「SearchAndExtractFiles」内の

outputFile = FreeFile()

で止まりました。直前行を

Dim outputFile As Long

に修正しました所、動作するように見えました。

1 Like

一応、キーワードが「ファイル名」に含まれるのか、「ファイルの内容」に含まれるのか、再確認しておきたいところか

フォルダ内に条件を満たすファイルがあるとき、ForEachの中身って何回実行されていますか?

himajin100000さん、今回生成されたコードは、キーワードが「ファイル名」に含まれるかの判定でした。今回「For Each」から「Do While」変更となり、Dirでファイル名が帰ってこなくなるまで繰り返し→ファイル名が条件と一致(キーワードが含まれる)していれば一旦配列に格納しつつ、最終的に「 ExtractedFiles,txt」にまとめて書き出すといった流れの様です。
「ファイル内」に指定のキーワードが含まれることが条件ですと、文字コード意識しながら判定する必要があるのか等、少々ハードル高くなりそうですね…

1 Like

皆様、様々なご意見ありがとうございます。

ChatGPTに「FreeFile()とはなに?」と問い合わせてみたところ以下の回答が来ました。
⇒FreeFile()は、Visual Basic言語で使用される関数の1つです。
この関数は、現在利用可能なファイル番号のうち、最小の未使用の番号を返します。
ファイル番号は、ファイルを開くときに使用され、ファイルにアクセスするために必要です。
FreeFile()を使用することで、プログラムが新しいファイルを開くときに
重複しない番号を取得できます。

「For Each file In files」の部分でエラーが出ていた件について、
コードの一番最初に「Option VBASupport 1」を入れるとエラーが解消されました。
ありがとうございます。

キーワード検索について、
Cドライブ直下にtestというフォルダを作成し、その中に「1,2,3,11」と4つのテキストファイルを作成しました。
マクロを実行し、パスは「C:\test」でキーワードを「1」でOKをすると「キーワードが含まれているファイルは見つかりませんでした。」と表示されました。
何か足りないのでしょうか…
キーワードが「ファイル名」に含まれるかの判定とのことでしたが、希望は「ファイル内」に指定のキーワードが含まれることが条件の方ですが、やはり難しくなりますか…

ChatGPTで「組んだ内容」の部分を変更して再度マクロを組んでもらいました。
以下が「組んだ内容」と「コード」です。
ただ、キーワード検索の部分で引っかかってまして…
フォルダ内のファイルで含まれているキーワードを入力してOKして
「検索が完了しました。」と表示後、結果ファイルのところを見に行くと
何も生成されていなくて…
どこが原因なのか…

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

「コード」

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

himajin100000さんが最初にメモとしてリンクを貼っているバグレポのとおり
現状ではCreateObject(“Scripting.FileSystemObject”)が機能していません
方法はいくつかあると思いますが、機能が近そうな
ScriptForgeを使った方法で一部書き直してみました
エンコードを自動判別してくれないのでエンコード指定を間違うと文字化けします

Sub SearchFilesKeywordB()
    Dim sFolderPath As String
    Dim sKeyword As String
    Dim sResultPath As String
    Dim oFileSystem 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 ' キャンセルされた場合は終了
    
    ' フォルダが存在するか確認
    
' LibreOfficeでCreateObject("Scripting.FileSystemObject")の代わり
	GlobalScope.BasicLibraries.LoadLibrary("ScriptForge")
	Set oFileSystem = CreateScriptService("FileSystem")

    If Not oFileSystem.FolderExists(sFolderPath) Then
        MsgBox "指定されたフォルダが見つかりません。", vbExclamation, "エラー"
        Exit Sub
    End If
    
	oFileSystem.FileNaming = "SYS"
	Dim fileList As Variant
	Dim file As String
	Dim myFile As Object
	'指定フォルダ内のテキストファイル取得
	fileList = oFileSystem.Files(sFolderPath, "*.txt")
	'テキストファイルリストから検索
	For Each file In fileList
			'OpenTextFile(ファイルパス, 読み込みモード, ファイルが存在しない場合に作成するか, エンコード(無指定だとUTF-8))
		myFile = oFileSystem.OpenTextFile(file, oFileSystem.ForReading, false, "Shift-JIS")
		If Not IsNull(myFile) Then
			sFileContents = myFile.ReadAll()
            ' キーワードが含まれるかチェック
            If InStr(1, sFileContents, sKeyword, vbTextCompare) > 0 Then
               ' キーワードが含まれている場合は結果ファイルに書き出す (というか保存先パスにテキストファイルを新しく作成する)
                Dim oResultFile As Object
                Set oResultFile = oFileSystem.OpenTextFile(sResultPath & "\" & oFileSystem.GetName(File), oFileSystem.ForWriting, True,"Shift-JIS")
                oResultFile.WriteLine sFileContents
                oResultFile.CloseFile()
            End If
            set myFile = myFile.Dispose()
		End If
	Next
'***
    
    MsgBox "検索が完了しました。", vbInformation, "完了"
    
End Sub
2 Likes

https://help.libreoffice.org/latest/ja/text/sbasic/shared/main0601.html?DbPAR=BASIC

ここですね!
これで調査がはかどります。

1 Like

https://help.libreoffice.org/latest/ja/text/sbasic/shared/03/sf_filesystem.html?&DbPAR=BASIC&System=UNIX

ScriptForge.FileSystem service

これが参考になりそうですね。

1 Like

Option VBASuppot 1
を最初に入れないと、 For each は使えなかった記憶があります。

1 Like