Please, is there any way to automatically detect all (or a significant portion of) corrupted .odt files (= LibreOffice reports that they can´t be opened after trying to do so / LibreOffice crashes after trying to open them without finally opening them etc.) within any folder and its subfolders? Or the best I can do is to open them manually? Thank you.
Without the operating system known, a general direction could be: create a shell script (because a macro won’t work, we know in advance that LibreOffice will crash) that would iterate the files, and run soffice --cat path/to/file.odt
. For each call, check the process returned value (it will be non-0 for crashes), and cerr output (it will be “Error: source file could not be loaded” for those that couldn’t be loaded).
It is probably possible to do this directly in LibreOffice if you call another instance of LO to check the file using the -env:UserInstallation
parameter.
right, using LibreOffice as a shell is also an option
I’ll try now.
You can use the TestOdtFiles macro.
An optional parameter is the folder for testing. If you do not specify it when calling the macro, the user will be prompted for it.
Option Compatible
Option Explicit
Dim oSFA As Object
' Checking .ods files in a folder and its subfolders.
Sub TestOdtFiles(Optional ByVal path As String)
Dim arr, arr2, index As Long, i As Long
Dim oDoc As Object, oSheet As Object, oRange as Object
Dim oPathSubstitution As Object, oStatusIndicator As Object, oFolderPicker As Object, oLocale As Object
Dim pInst As String, pTemp As String, soffice As String, aSplit, fout as String, retval, result, parm As String
If IsMissing(path) Then path=""
If path="" Then
oFolderPicker=CreateUnoService("com.sun.star.ui.dialogs.FolderPicker")
oFolderPicker.setTitle "Select a folder to check .odt files"
retval=oFolderPicker.execute()
If retval=0 Then Exit Sub
path=oFolderPicker.getDirectory()
End If
oSFA=CreateUnoService("com.sun.star.ucb.SimpleFileAccess")
ReDim arr(999)
index=-1
getFileList arr, index, path, "*.odt", True
If index=-1 Then
Msgbox "No .odt files found"
Exit Sub
End If
oDoc=StarDesktop.LoadComponentFromUrl("private:factory/scalc","_default",0, Array())
oSheet=oDoc.Sheets(0)
oSheet.getCellRangeByPosition(0,0,1,0).setDataArray Array(Array("File path", "Result"))
If Msgbox("Number of files to check: " & (index+1) & Chr(10) & "Continue?", MB_YESNO + MB_ICONQUESTION)<> IDYES Then
Exit Sub
End If
oPathSubstitution=CreateUnoService("com.sun.star.util.PathSubstitution")
pInst=oPathSubstitution.getSubstituteVariableValue("$(inst)")
pTemp=oPathSubstitution.getSubstituteVariableValue("$(temp)")
aSplit=Split(pInst, "/")
If lcase(aSplit(Ubound(aSplit)))="libreoffice" Then
aSplit(Ubound(aSplit))=aSplit(Ubound(aSplit)) & "/program/soffice"
ElseIf lcase(aSplit(Ubound(aSplit)))="program" Then
aSplit(Ubound(aSplit))=aSplit(Ubound(aSplit)) & "/soffice"
Else
aSplit(Ubound(aSplit))="soffice"
End If
soffice=Join(aSplit, "/")
oStatusIndicator=oDoc.CurrentController.statusIndicator
oStatusIndicator.Start "File check", 100
For i=0 To Index
aSplit=Split(arr(i), "/")
fout=pTemp & "/LoTest/" & aSplit(Ubound(aSplit))
fout=Left(fout, Len(fout)-3) & "txt"
If oSFA.exists(fout) Then oSFA.kill(fout)
parm="-env:UserInstallation=" & pTemp & "/LibreOffice" & " --convert-to txt:Text " & " --outdir " & pTemp & "/LoTest " & arr(i)
retval=Shell(soffice, 0, parm, True)
result="Error"
If oSFA.exists(fout) Then result="OK"
oSheet.getCellByPosition(0, i+1).setString arr(i)
oSheet.getCellByPosition(1, i+1).setString result
If oSFA.exists(fout) Then oSFA.kill(fout)
oStatusIndicator.setText "File check: " & (i+1) & " of " & (index+1)
oStatusIndicator.setValue Cdbl(i+1) / (index+1) *100
Next i
' Format Range
oSheet.getCellRangeByPosition(0, 0, 1, 0).cellStyle="Accent 3"
oRange=oSheet.getCellRangeByPosition(0, 0, 1, index+1)
' Don't check spelling
oLocale=oRange.CharLocale
oLocale.Country=""
oLocale.Language="zxx"
oRange.CharLocale=oLocale
oRange.isTextWrapped=False
' AutoFilter
oDoc.DatabaseRanges.addNewByName("db_1", oRange.RangeAddress)
oDoc.DatabaseRanges.getByName("db_1").autoFilter=True
' OptimalWidth
For i = 0 To oRange.Columns.Count-1
oSheet.Columns.getByIndex(i).OptimalWidth=True
Next i
oStatusIndicator.end
End Sub
Sub getFileList(ByRef arr, ByRef index, ByVal path, Byval pattern, ByVal subFolders As Boolean)
Dim file As String, aFiles
aFiles=oSFA.getFolderContents(path, subFolders)
For Each file In aFiles
If oSFA.isFolder(file) Then
getFileList arr, index, file, pattern, subFolders
Else
If LCase(file) Like LCase(pattern) Then
index=index+1
If index>UBound(arr) Then
ReDim Preserve arr(UBound(arr) * 2)
End If
arr(index)=file
End If
End If
Next file
End Sub