PureBasic Forums - English

Code: Select all

; Word-Doc to HTML

IncludePath #PB_Compiler_Home + "comate\"
XIncludeFile "COMate.pbi"

EnableExplicit

#wdFormatHTML         =  8
#wdFormatFilteredHTML = 10
  
Procedure GetFormatHTML(WordApplication.COMateObject)
  
  ; inspired by Joost Schwider
  ; http://vb-tec.de/wordhtml.htm
  
  Protected FileConverter.COMateObject
  Protected FileConverters.COMateEnumObject
  Protected SaveFormat
  
  Debug WordApplication\GetIntegerProperty("Version")
  
  If WordApplication\GetIntegerProperty("Version") > 8 
    SaveFormat = #wdFormatHTML
  Else
    
    FileConverters = WordApplication\CreateEnumeration("FileConverters")
    
    If FileConverters
      
      FileConverter = FileConverters\GetNextObject()
      While FileConverter
        If FileConverter\GetStringProperty("ClassName") = "HTML"
          
          SaveFormat = FileConverter\GetIntegerProperty("SaveFormat")
          
          FileConverter\Release()
          Break
          
        EndIf
        FileConverter\Release()
        FileConverter = FileConverters\GetNextObject()
      Wend
      FileConverters\Release()
    EndIf
    
  EndIf
  
  ProcedureReturn SaveFormat
  
EndProcedure

Procedure ShowErrorIfAny()
  
  If COMate_GetLastErrorCode()
    Debug COMate_GetLastErrorDescription()
  EndIf
  
EndProcedure
            
Procedure Doc2Html(Infile.s, OutFile.s)
  
  Protected ReturnValue
  Protected WordApplication.COMateObject
  
  ReturnValue = #False
  
  If FileSize(Infile) = -1
    Debug "file not found"
  Else
    
    WordApplication = COMate_CreateObject("Word.Application")
    
    If WordApplication
      
      If WordApplication\Invoke("Documents\Open('" + Infile + "')") = #S_OK
        If WordApplication\Invoke("ActiveDocument\SaveAs('" + OutFile + "', " + Str(GetFormatHTML(WordApplication)) + " As Long)") = #S_OK
          ReturnValue = #True
        Else
          Debug "!ActiveDocument\SaveAs"
          Debug ShowErrorIfAny()
        EndIf
        WordApplication\Invoke("Quit(0)")
      Else
        Debug "!Documents\Open"
      EndIf
      
      WordApplication\Release()
      
    Else
      
      Debug "!WordApplication"
      Debug ShowErrorIfAny()
      
    EndIf
    
  EndIf
  
  ProcedureReturn ReturnValue
  
EndProcedure

Define Infile.s  = "D:\Test1.doc"
Define OutFile.s = "D:\fromTest1Doc.html"

If Doc2Html(Infile, OutFile) = #True  
  RunProgram(OutFile)
EndIf