'Werner Roth <tiberius@uni-paderborn.de>

'Try to rescue faulty documents
'If StarOffice Writer loads your file, but crashes by displaying it
'this macro may be a help. It tries to convert it into several
'file formats (StarWriter 3.0, StarWriter 4.0, MS Word,
'RTF, HTML und TXT).
'these files will be saved into the same directory than the source file


Option Explicit

Sub RescueFaultyDocument
   Dim StrSourceFileName As String
   Dim StrListOfFiles As String
   Dim oDocument As Object

   StrSourceFileName = Application.DefaultFilePath 'StarOffice workfolder
   StrSourceFileName = InputBox("Input the complete filename of the faulty document." & chr(13) &_
                                "E.g.: ""c:\My Files\seminar.sdw"""  & chr(13) &_
                                "The converted files will be saved into the same directory.",_
                                "Rescue your Document", _
                            StrSourceFileName)

   'Check if this file exists
   If Dir(StrSourceFileName,0) <> FileNameWithoutPath(StrSourceFileName) Then
      MsgBox("The File """ & StrSourceFileName & """ doesn't exist!", 16, "Error")
      Exit Sub
   End If
   
   On Local Error Goto ErrorLabel
   Application.EnterWait() 'Hourglass-Cursor on
   
   'Open the document hidden, in order not to layout the text
   
   oDocument = Documents.Open(StrSourceFileName,,"H" )

   'Wait until it's loaded
   Do While oDocument.IsLoading or oDocument.IsLoadingImages
      Wait 100
   Loop
   'Give StarOffice Writer a chance to initialise it
   Wait 100

   'We have the document, now convert it
   StrListOfFiles = ConvertTheDocument(oDocument,_
                      NameWithoutSuffix(StrSourceFileName) & "_StarWriter_4_0.sdw",_
                      "swriter: StarWriter 4.0")
   StrListOfFiles = StrListOfFiles & chr(13) & ConvertTheDocument(oDocument,_
                      NameWithoutSuffix(StrSourceFileName) & "_StarWriter_3_0.sdw",_
                      "swriter: StarWriter 3.0")
   StrListOfFiles = StrListOfFiles & chr(13) &    ConvertTheDocument(oDocument,_
                      NameWithoutSuffix(StrSourceFileName) & ".doc",_
                      "swriter: MS WinWord 6.0")
   StrListOfFiles = StrListOfFiles & chr(13) &    ConvertTheDocument(oDocument,_
                      NameWithoutSuffix(StrSourceFileName) & ".rtf",_
                      "swriter: Rich Text Format")
   StrListOfFiles = StrListOfFiles & chr(13) &    ConvertTheDocument(oDocument,_
                      NameWithoutSuffix(StrSourceFileName) & ".html",_
                      "swriter: HTML (StarWriter)")
   StrListOfFiles = StrListOfFiles & chr(13) &    ConvertTheDocument(oDocument,_
                      NameWithoutSuffix(StrSourceFileName) & ".txt", "swriter: Text", "", "" )
   'mach das Dokument wieder zu...
   oDocument.Close(False, "")

   Application.LeaveWait() 'Hourglass-Cursor off
   
   MsgBox("I've written the following documents: " & chr(13) &_
          StrListOfFiles, 64, "Finished!")

   'Go away! Don't trap into the error handling stuff
   Exit Sub
   ErrorLabel:
      Application.LeaveWait() 'Hourglass-Cursor off
      'Don't know what could happend here, so drop a generic error-message
      MsgBox("During the convert of documents" & chr(13) &_
             "the following error occurred:" & chr(13) &_
             Error() & chr(13) &_
             "Error No.: " & Err() , 16,_
             "Unknown Error")
End Sub

Function NameWithoutSuffix(StrFileName As String) As String
'Cut the suffix. Because we want to change "MyDocument.sdw" to "MyDocument.doc"
   Dim i As Integer
   'Find a ".". Search beginning from the end of the filename
   For i = Len( StrFileName ) To 1 Step -1
      If Mid( StrFileName, i, 1 ) = "." Then
         NameWithoutSuffix = Mid(StrFileName, 1,  i - 1)
         Exit Function
      End If
   Next i
   'If you didn't found a "." pass back the old string
   NameWithoutSuffix = StrFileName
End Function

Function FileNameWithoutPath(StrFileName As String) As String
'Mache aus "C:\Eigene Dateien\seminar.sdw" "seminar.sdw"

   Dim i As Integer
   'Find a path seperator like "\". Search beginning from the end of the filename
   For i = Len( StrFileName ) To 1 Step -1
      If Mid( StrFileName, i, 1 ) = GetPathSeparator() Then
         FileNameWithoutPath = Mid(StrFileName, i + 1, Len( StrFileName ))
         Exit Function
      End If
   Next i
   'If you didn't found a path seperator pass back the old string
   FileNameWithoutPath = StrFileName
End Function

Function ConvertTheDocument(oDocument As Object, StrDestName As String,_
         StrFilter As String) As String
   'Convert the given document to the needed type
   'Pass back the short filename of the destination file
   oDocument.SaveAs(StrDestName, StrFilter, "", "" )
   ConvertTheDocument = FileNameWithoutPath(StrDestName)
End Function