'Werner Roth 'Konvertiert StarWriter-Dokumente in das WinWord-Format 'Nach Angabe eines Verzeichnisses werden alle darin liegenden ".SDW"-Dokumente 'in das Winword-Format konvertiert. dazu wird ein Unterverzeichnis "Konverte" angelegt. 'Durch Änderung der Suffixe und Filternamen zu beginn des Quellcodes können beliebige 'Dokumente hin- und her konvertiert werden. 'Vielleicht produziere ich noch eine Dialog-Version, bei der man dann Quelle und Ziel 'auswählen kann. Sub OpenAndConvert 'Durch ändern der Suffixe für Quell- und Zieldatei, sowie des Filternamens kann dieses 'Makro beliebiges konvertieren. 'An den Filternamen kommt man, durch '-Dokument öffnen '-Makro Aufzeichnung starten '-Datei|Speichern unter '-Makro Aufzeichnung beenden und den generierten Code anschauen Const cSourceSuffix = ".sdw" Const cDestSuffix = ".doc" Const cConvertFilterName = "swriter: MS WinWord 6.0" '"swriter: MS WinWord 6.0" ist (in StarOffice 5.x gleich "swriter: MS Word 95" und "swriter: MS Word 97" 'Andere Suffixe/Filter '".sdw", "swriter: StarWriter 5.0" '".html", "swriter: HTML (StarWriter)" '".txt", "swriter: Text" '".rtf", "swriter: Rich Text Format" Dim StrSourcePath As String Dim StrConvertPath As String Dim StrActFileName As String Dim oDocument As Object 'Alle Dokumente eines Verzeichnisses werden konvertiert. Das Ausgangsverzeichnis kann beliebig 'voreingestellt werden: StrSourcePath = Application.DefaultFilePath 'Application.PathSettings.Work StrSourcePath = InputBox("Gib einen Pfad an, in dem sich die StarWriter-Dokumente befinden." & chr(13) &_ "Diese werden dann nach MS Word 6.0/95/97 konvertiert und in ein" & chr(13) &_ "Unterverzeichnis ""Konverte"" geschrieben!", _ "Konvertieren von StarWriter-Dokumenten ", _ StrSourcePath) 'Prüfe ob das Verzeichnis existiert, falls ja ergibt Dir(StrSourcePath,16) "." If Dir(StrSourcePath,16) = "" Then MsgBox("Der Pfad """ & StrSourcePath & """ existiert nicht!", 16, "Fehler") Exit Sub End If 'Lege ein Zielverzeichnis an, dies ist ein Unterinhaltsverzeichnis Namens "Konverte" 'Prüfe dazu, ob es schon da ist. Falls nicht lege es an. StrConvertPath = StrSourcePath & GetPathSeparator() & "Konverte" If Dir(StrConvertPath,16 )= "" Then MkDir(StrConvertPath) End If '******************************************************************************* 'Nun geht's los! Arbeite jede Datei, die in diesem Verzeichnis liegt ab 'Die aktuell bearbeitete Datei ist "StrActFileName" StrActFileName = Dir(StrSourcePath & GetPathSeparator() & "*" & cSourceSuffix, 0) If StrActFileName = "" Then MsgBox("Im Pfad """ & StrSourcePath & """ befindet sich kein """ & _ cSourceSuffix & """-Dokument!", 16, "Fehler") Exit Sub End If 'Fehlerbehandlung übernehme ich selbst, damit ich im Falle eines Fehlers den 'Sanduhr-Cursor wieder ausschalten kann On Local Error Goto ErrorLabel Application.EnterWait() 'Sanduhr-Cursor ein Do 'Öffne das Dokument und zwar versteckt "H". Das geht schneller und flackert nicht auf dem Bildschirm. oDocument = Documents.Open(StrSourcePath & GetPathSeparator() & StrActFileName,,"H" ) 'Nun warte mal schön bis das Dokument geladen ist Do While oDocument.IsLoading or oDocument.IsLoadingImages Wait 100 Loop 'Warte noch ein kleines bisschen, damit sich StarWriter richtig initialisieren kann Wait 100 'Dokument ist geladen, nun speichere es im gewünschten Format oDocument.SaveAs(StrConvertPath & GetPathSeparator() & _ NameWithoutSuffix(StrActFileName) + cDestSuffix, _ cConvertFilterName, "", "" ) 'mach das Dokument wieder zu... oDocument.Close(False, "") '...und hole dir den nächsten Dateinamen StrActFileName = Dir() 'Solange bis nichts mehr da ist Loop Until StrActFileName = "" Application.LeaveWait() 'Sanduhr-Cursor aus '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