'Werner Roth 'Makro, dass versucht defekte Dokumente zu retten. 'Falls die StarOffice Writer Datei zwar geladen, aber nicht angezeigt 'werden kann, lädt dieses Makro die defekte Datei und konvertiert sie 'in diverse andere Dateiformate (StarWriter 3.0, StarWriter 4.0, MS Word, 'RTF, HTML und TXT). 'Die Konverte werden in das selbe Verzeichnis geschrieben. Option Explicit Sub RescueFaultyDocument Dim StrSourceFileName As String Dim StrListOfFiles As String Dim oDocument As Object StrSourceFileName = Application.DefaultFilePath 'StarOffice Arbeitsverzeichnis StrSourceFileName = InputBox("Gib den kompletten Pfad und Suffix des defekten Dokuments ein." & chr(13) &_ "Zum Beispiel: ""c:\Eigene Dateien\seminar.sdw""" & chr(13) &_ "Die Konverte werden in das selbe Verzeichnis geschrieben.",_ "Dateirettung", _ StrSourceFileName) 'Prüfe ob die Datei existiert If Dir(StrSourceFileName,0) <> FileNameWithoutPath(StrSourceFileName) Then MsgBox("Das Dokument """ & StrSourceFileName & """ existiert nicht!", 16, "Fehler") Exit Sub End If On Local Error Goto ErrorLabel Application.EnterWait() 'Sanduhr-Cursor ein 'Das Dokument versteckt öffnen, damit es nicht formatiert wird! oDocument = Documents.Open(StrSourceFileName,,"H" ) 'Nun warte bis das Dokument geladen ist Do While oDocument.IsLoading or oDocument.IsLoadingImages Wait 100 Loop 'Warte noch ein kleines bisschen, damit sich StarOffice Writer richtig initialisieren kann Wait 100 'Dokument ist geladen, schreibe es in anderen Formaten raus: 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() 'Sanduhr-Cursor aus MsgBox("Folgende Dokumente wurden geschrieben: " & chr(13) &_ StrListOfFiles, 64, "Fertig!") 'Raus hier! Wir wollen nicht in die Fehlerbehandlung abgleiten Exit Sub ErrorLabel: Application.LeaveWait() 'Sanduhr-Cursor aus 'Keine Ahnung was hier alles passiert sein könnte, 'also gib eine generierte Fehlermeldung aus. MsgBox("Beim Konvertieren von Dokumenten" & chr(13) &_ "trat folgende Fehlermeldung auf:" & chr(13) &_ Error() & chr(13) &_ "Fehler Nr.: " & Err() , 16,_ "Unbekannter Fehler") End Sub Function NameWithoutSuffix(StrFileName As String) As String 'Schneide das Suffix ab. Wir wollen ja aus dem Dokument 'MeinDokument.sdw -- MeinDokument.doc machen Dim i As Integer 'Schaue von rechts nach links nach, bis du einen "." findest. 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 'Falls kein "." drin war gib den alten String zurück NameWithoutSuffix = StrFileName End Function Function FileNameWithoutPath(StrFileName As String) As String 'Mache aus "C:\Eigene Dateien\seminar.sdw" "seminar.sdw" Dim i As Integer 'Schaue von rechts nach links nach, bis du einen "\" oder 'eben einen Pfad-Seperator findest. 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 'Falls kein Pfad-Seperator drin war gib den alten String zurück FileNameWithoutPath = StrFileName End Function Function ConvertTheDocument(oDocument As Object, StrDestName As String,_ StrFilter As String) As String 'Konvertiere das mitgegebene oDocument und gib den Dateinamen des 'Konverts (in Kurzform) zurück. oDocument.SaveAs(StrDestName, StrFilter, "", "" ) ConvertTheDocument = FileNameWithoutPath(StrDestName) End Function