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

'Converts StarWriter (TM)-documents into MS Word (TM) documents
'Other conversions are easily possible
'After starting this macro you have to specify the directory with ".SDW"-files to convert
'the WinWord-files will be stored in a sub-directory named "Convert"

'You can change suffixes and names of StarOffice filters in this source code to convert
'documents in other formats
'To figure out names of other filters
'  - Open a document
'  - Start macro recording
'  - File|Save as
'  - Choose the desired format and save the file
'  - Take a look at the generated code

Sub OpenAndConvert
   Const cSourceSuffix = ".sdw"
   Const cDestSuffix = ".doc"
   Const cConvertFilterName = "swriter: MS WinWord 6.0"
   'StarOffice 5.x the filter names 
   '"swriter: MS WinWord 6.0",
   '"swriter: MS Word 95" and 
   '"swriter: MS Word 97"
   'are the same! 
   'Examples of other suffixes/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

   'We are going to convert every file in a given directory
   'place a default directory of your choice in the next line
   StrSourcePath = Application.DefaultFilePath 'Application.PathSettings.Work
   StrSourcePath = InputBox("Specify the directory with "".SDW""-files to convert" & chr(13) &_
                            "these files will be converted into MS Word 6.0/95/97-files" & chr(13) &_
                            "stored in a sub-directory named ""Convert""", _
                            "Converting StarWriter-Documents ", _
                            StrSourcePath)

   'Check the existence of the given directory, if the directory exists the result of Dir(StrSourcePath,16) will be at least "."
   If Dir(StrSourcePath,16) = "" Then
      MsgBox("The directory """ & StrSourcePath & """ dosn't exist!", 16, "Error")
      Exit Sub
   End If
   
   'Create the target dirrectory. This is a sub-directory named "Convert"
   'Check if this is already there. If not, create it.
   StrConvertPath = StrSourcePath & GetPathSeparator() & "Convert"
   If Dir(StrConvertPath,16 )= "" Then
      MkDir(StrConvertPath)
   End If


   '*******************************************************************************
   'Lets go! Take each file in this directory.
   'The actual file is "StrActFileName"

   StrActFileName = Dir(StrSourcePath & GetPathSeparator() & "*" & cSourceSuffix, 0)
   
   If StrActFileName = "" Then
      MsgBox("In """ & StrSourcePath & """ are no """ & _
             cSourceSuffix & """-documents!", 16, "Error")
      Exit Sub
   End If

   'Errorhandling is driven by me, because I want to turn the hourglass-cursor off
   'in case of error 
   On Local Error Goto ErrorLabel
   Application.EnterWait() 'invoke hourglass-cursor
   Do
      'Open the document hidden "H". This is faster and avoids flickering on the screen
      oDocument = Documents.Open(StrSourcePath & GetPathSeparator() & StrActFileName,,"H" )
      'Wait and stay tuned untill the document is loaded
      Do While oDocument.IsLoading or oDocument.IsLoadingImages
         Wait 100
      Loop
      'still wait a bit to give StarWriter a chance to initialise
      Wait 100

      'document is loaded, save it in desired format
      oDocument.SaveAs(StrConvertPath & GetPathSeparator() & _
                       NameWithoutSuffix(StrActFileName) + cDestSuffix, _
                       cConvertFilterName, "", "" )
      'and close it again
      oDocument.Close(False, "")
      'check for the next file name
      StrActFileName = Dir()
      'until there is no filename anymore
   Loop Until StrActFileName = "" 
   Application.LeaveWait() 'hourglass-cursor off
   '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