Private Declare Function ILmakeILenvironment Lib "i-loop.dll" () As Long
Private Declare Function ILstartJVM Lib "i-loop.dll" (ByVal jarLocation As String, ByVal jvmLocation As String) As Long

Private Declare Function ILgetErrorMessage Lib "i-loop.dll" () As String
Private Declare Function ILgetErrorMessageDetails Lib "i-loop.dll" () As String
Private Declare Function ILgetJavaErrorMessage Lib "i-loop.dll" () As String

Private Declare Function UCsaveXMLwithDialog Lib "i-loop.dll" (ByVal fileName As String) As Long
Private Declare Function UCgetSaveXMLwithDialogDestinationDir Lib "i-loop.dll" () As String

Private Declare Function UCsetLicense Lib "i-loop.dll" (ByVal licenseLocation As String) As Long
Private Declare Function UCcreateEngine Lib "i-loop.dll" () As Long
Private Declare Function UCengineCreated Lib "i-loop.dll" () As Long
Private Declare Function UCsetDebuggingMode Lib "i-loop.dll" (ByVal mode As Integer) As Long
Private Declare Function UCsetGlobalParameter Lib "i-loop.dll" (ByVal parameterName As String, ByVal parameterValue As String) As Long
Private Declare Function UCsetImportFilterType Lib "i-loop.dll" (ByVal importType As Integer) As Long
Private Declare Function UCsetImportFilterParameter Lib "i-loop.dll" (ByVal parameterName As String, ByVal parameterValue As String) As Long
Private Declare Function UCimportFile Lib "i-loop.dll" (ByVal fileName As String) As Long
Private Declare Function UCsetExportFilterType Lib "i-loop.dll" (ByVal exportType As Long) As Long
Private Declare Function UCsetExportFilterParameter Lib "i-loop.dll" (ByVal parameterName As String, ByVal parameterValue As String) As Long
Private Declare Function UCexportFile Lib "i-loop.dll" (ByVal fileName As String) As Long
Private Declare Function UCconvertDocumentWithConfiguration Lib "i-loop.dll" (ByVal parameterName As String, ByVal parameterValue As String, ByVal parameterValue As String) As Long

Private Declare Function DCloadXMLwithDialog Lib "i-loop.dll" (ByVal destDir As String) As Long
Private Declare Function DCgetLoadXMLwithDialogDestinationFile Lib "i-loop.dll" () As String

Private Declare Function DCsetLicense Lib "i-loop.dll" (ByVal licenseLocation As String) As Long
Private Declare Function DCcreateEngine Lib "i-loop.dll" () As Long
Private Declare Function DCengineCreated Lib "i-loop.dll" () As Long
Private Declare Function DCsetDebuggingMode Lib "i-loop.dll" (ByVal mode As Integer) As Long
Private Declare Function DCsetGlobalParameter Lib "i-loop.dll" (ByVal parameterName As String, ByVal parameterValue As String) As Long
Private Declare Function DCconvertFile Lib "i-loop.dll" (ByVal fileLocation As String, ByVal destDir As String, ByVal procSheet As String) As Long


Private Const kRTFImportType           As Long = 1

Private Const kXMLExportType           As Long = 3
Private Const kXHTMLExportType         As Long = 5
Private Const kCSSExportType           As Long = 6
Private Const kValidatorExportType     As Long = 7
Private Const kCommandLineExportType   As Long = 8
Private Const kXSLTPRocessorExportType As Long = 10
Private Const kDocBookExportType       As Long = 11


Option Explicit


Sub saveSelectionToXMLwithDialog()
'
' this sub saves the current selection to XML by calling the GUI of upCast
' upCast VBA components must be installed (via the upCast GUI) on your system
' requires only the upCast GUI license
'
If (Selection.Start = Selection.End) Then
    MsgBox "Nothing selected to be converted to XML"
    Exit Sub
End If

'
' copy the current selection
'
Selection.Copy

'
' set some vars for the handling of the word file
'
Dim retVal As Long
Dim tmpFileName As String
Dim tmpDoc As Document

'
' create a tmp file where we save the document in RTF format
'
tmpFileName = Environ("TEMP") & "\" & "selection.rtf"
    
'
'open a new document and make it the active document
'
Set tmpDoc = Documents.Add(Visible:=False)
tmpDoc.Activate

'
'paste everything into the new document
'
Selection.Paste
    
'
'delete (if possible) the last par marker in the target document
'
Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1

'
'save the new document in RTF format
'
tmpDoc.SaveAs fileName:=tmpFileName, FileFormat:=wdFormatRTF, _
        LockComments:=False, Password:="", AddToRecentFiles:=False, WritePassword _
        :="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
        SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:=False
    
'
'close the new document
'
tmpDoc.Close

'
' call upCast and convert the document
'
retVal = UCsaveXMLwithDialog(tmpFileName)

'
' remove the tmp file
'
Kill tmpFileName

'
' give the user some feedback
'
If (retVal = 0) Then
    If (UCgetSaveXMLwithDialogDestinationDir() <> "") Then
        MsgBox "Selection successfully converted to output dir: '" & UCgetSaveXMLwithDialogDestinationDir() & "'"
    Else
        MsgBox "Conversion was canceled"
    End If
Else
    MsgBox "Error while converting document"
End If

End Sub


Sub saveFileToXMLwithDialog()
'
' this sub saves a document to XML by calling the GUI of upCast
' before a file may be converted to XML it has to be saved
' upCast VBA components must be installed (via the upCast GUI) on your system
' requires only the upCast GUI license
'

'
' set some vars for the handling of the word file
'
Dim retVal As Long
Dim tmpFileName As String
Dim tmpDoc As Document

'
' test if there is an open document
'
If (Application.Documents.Count = 0) Then
    MsgBox "There is no open document to be converted."
    Exit Sub
End If

'
' test if the file is saved
'
If (Not Application.ActiveDocument.Saved) Then
    MsgBox "Please save document before saving it to XML."
    Exit Sub
End If

'
' create a tmp file where we save the document in RTF format
'
tmpFileName = Environ("TEMP") & "\" & Application.ActiveDocument.Name

'
'select everything in the current document
'
Application.ScreenUpdating = False
Selection.WholeStory
Selection.Copy
Selection.Collapse
Application.ScreenUpdating = True
    
'
'open a new document and make it the active document
'
Set tmpDoc = Documents.Add(Visible:=False)
tmpDoc.Activate
    
'
'paste everything into the new document
'
Selection.Paste

'
'delete (if possible) the last par marker in the target document
'
Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1

'
'save the new document in RTF format
'
tmpDoc.SaveAs fileName:=tmpFileName, FileFormat:=wdFormatRTF, _
        LockComments:=False, Password:="", AddToRecentFiles:=False, WritePassword _
        :="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
        SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:=False
    
'
'close the new document
'
tmpDoc.Close

'
' call upCast and convert the document
'
retVal = UCsaveXMLwithDialog(tmpFileName)

'
' remove the tmp file
'
Kill tmpFileName

'
' give the user some feedback
'
If (retVal = 0) Then
    If (UCgetSaveXMLwithDialogDestinationDir() <> "") Then
        MsgBox "Document successfully converted to output dir: '" & UCgetSaveXMLwithDialogDestinationDir() & "'"
    Else
        MsgBox "Document conversion was canceled"
    End If
Else
    MsgBox "Error while converting document"
End If

End Sub


Sub saveXMLwithConfig()
'
' this sub saves a document to XML by calling the upCast API with a named configuration
' requires the upCast API license
'

'
' set some vars needed for the initialization of upCast
'
Dim upCastJarLocation As String
Dim jdkLocation As String
Dim upCastLicenseLocation As String
upCastJarLocation = "" ' if possible (upCast VBA components must be installed), this parameter is fetched from the registry (but you may override it)
jdkLocation = "" ' if possible (upCast VBA components must be installed), this parameter is fetched from the registry (but you may override it)
upCastLicenseLocation = "" ' if possible (upCast VBA components must be installed), this parameter is fetched from the registry (but you may override it)

Dim targetDir As String
Dim configurationLocation As String
targetDir = "C:\mswindows\upcast\output\" ' change this to your needs
configurationLocation = "C:\mswindows\upcast\c1.config" ' change this to your needs

'
' set some vars for the handling of the word file
'
Dim retVal As Long
Dim tmpFileName As String
Dim tmpDoc As Document

'
' create a tmp file where we save the document in RTF format
'
tmpFileName = Environ("TEMP") & "\" & Application.ActiveDocument.Name

'
'select everything in the current document
'
Application.ScreenUpdating = False
Selection.WholeStory
Selection.Copy
Selection.Collapse
Application.ScreenUpdating = True
    
'
'open a new document and make it the active document
'
Set tmpDoc = Documents.Add(Visible:=False)
tmpDoc.Activate
    
'
'paste everything into the new document
'
Selection.Paste

'
'delete (if possible) the last par marker in the target document
'
Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1

'
'save the new document in RTF format
'
tmpDoc.SaveAs fileName:=tmpFileName, FileFormat:=wdFormatRTF, _
        LockComments:=False, Password:="", AddToRecentFiles:=False, WritePassword _
        :="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
        SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:=False
    
'
'close the new document
'
tmpDoc.Close

'
' do we have to initialize upCast ?
'
If (UCengineCreated() <> 0) Then
    retVal = ILmakeILenvironment() & ILstartJVM(upCastJarLocation, jdkLocation) & UCsetLicense("") & UCcreateEngine()
    If (retVal <> 0) Then
        MsgBox "Error while initializing upCast" & ILgetErrorMessage() & ILgetErrorMessageDetails()
        Exit Sub
    End If
End If

'
' call upCast to convert the document to XML, using a configuration
'
retVal = UCconvertDocumentWithConfiguration(tmpFileName, targetDir, configurationLocation)

'
' test if everything went fine
'
If (retVal = 0) Then
    MsgBox "Document successfully converted"
Else
    MsgBox "Error while converting document"
End If

'
' finally remove the tmp file
'
Kill tmpFileName

End Sub


Sub saveXMLdetailed()
'
' this sub saves a document to XML by calling the upCast API
' requires the upCast API license
'

'
' set some vars needed for the initialization of upCast
'
Dim upCastJarLocation As String
Dim jdkLocation As String
Dim upCastLicenseLocation As String
upCastJarLocation = "" ' if possible (upCast VBA components must be installed), this parameter is fetched from the registry (but you may override it)
jdkLocation = "" ' if possible (upCast VBA components must be installed), this parameter is fetched from the registry (but you may override it)
upCastLicenseLocation = "" ' if possible (upCast VBA components must be installed), this parameter is fetched from the registry (but you may override it)

'
' set some vars for the handling of the word file
'
Dim retVal As Long
Dim tmpFileName As String
Dim tmpDoc As Document

'
' create a tmp file where we save the document in RTF format
'
tmpFileName = Environ("TEMP") & "\" & Application.ActiveDocument.Name

'
'select everything in the current document
'
Application.ScreenUpdating = False
Selection.WholeStory
Selection.Copy
Selection.Collapse
Application.ScreenUpdating = True
    
'
'open a new document and make it the active document
'
Set tmpDoc = Documents.Add(Visible:=False)
tmpDoc.Activate
    
'
'paste everything into the new document
'
Selection.Paste

'
'delete (if possible) the last par marker in the target document
'
Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1
    
'
'save the new document in RTF format
'
tmpDoc.SaveAs fileName:=tmpFileName, FileFormat:=wdFormatRTF, _
        LockComments:=False, Password:="", AddToRecentFiles:=False, WritePassword _
        :="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
        SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:=False
    
'
'close the new document
'
tmpDoc.Close

'
' do we have to initialize upCast ?
'
If (UCengineCreated() <> 0) Then
    retVal = ILmakeILenvironment() & ILstartJVM(upCastJarLocation, jdkLocation) & UCsetLicense("") & UCcreateEngine()
    If (retVal <> 0) Then
        MsgBox "Error while initializing upCast"
        Exit Sub
    End If
End If

'
' call upCast to convert the document to XML
'
retVal = UCsetImportFilterType(kRTFImportType)
retVal = UCsetImportFilterParameter("IncludeImages", "true")
retVal = UCsetGlobalParameter("outputDir", "C:\mswindows\upcast\output\")
retVal = UCimportFile("C:\mswindows\upcast\input\demo.rtf")
retVal = UCsetExportFilterType(kXMLExportType)
retVal = UCexportFile("a.xml")

'
' test if everything went fine
'
If (retVal = 0) Then
    MsgBox "Document successfully converted"
Else
    MsgBox "Error while converting document"
End If

'
' finally remove the tmp file
'
Kill tmpFileName

End Sub


Sub loadXMLwithDialog()
'
' this sub loads a document from XML by calling the GUI of downCast
' downCast VBA components must be installed (via the downCast GUI) on your system
' requires only the downCast GUI license
'

Dim retVal As Long
Dim targetFile As String

retVal = DCloadXMLwithDialog("file:/C:/Documents and Settings/Administrator/Desktop/output/")

'
' test if everything went fine
'
If (retVal = 0) Then
    If (DCgetLoadXMLwithDialogDestinationFile() <> "") Then
        MsgBox "Document successfully converted to : '" & DCgetLoadXMLwithDialogDestinationFile() & "'"
        '
        ' get the target file name from downCast as it was specified by the user
        '
        targetFile = DCgetLoadXMLwithDialogDestinationFile()

        '
        ' load the document
        '
        Documents.Open fileName:=targetFile, ConfirmConversions:=False _
            , ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", _
            PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _
            WritePasswordTemplate:="", Format:=wdOpenFormatAuto
    Else
        MsgBox "Document conversion was canceled"
    End If
Else
    MsgBox "Error while converting document"
    Exit Sub
End If

End Sub


Sub loadXMLdetailed()
'
' this sub loads a document from XML by calling the downCast API
' requires the downCast API license
'

'
' set some vars needed for the initialization of downCast
'
Dim downCastJarLocation As String
Dim jdkLocation As String
Dim upCastLicenseLocation As String
downCastJarLocation = "" ' if possible (upCast VBA components must be installed), this parameter is fetched from the registry (but you may override it)
jdkLocation = "" ' if possible (upCast VBA components must be installed), this parameter is fetched from the registry (but you may override it)
upCastLicenseLocation = "" ' if possible (upCast VBA components must be installed), this parameter is fetched from the registry (but you may override it)

Dim retVal As Long

'
' do we have to initialize upCast ?
'
If (DCengineCreated() <> 0) Then
    retVal = ILmakeILenvironment() & ILstartJVM(downCastJarLocation, jdkLocation) & DCsetLicense("") & DCcreateEngine()
    If (retVal <> 0) Then
        MsgBox "Error while initializing downCast"
        Exit Sub
    End If
End If

'
' call downCast to convert the document to XML
'
Dim fileName As String
Dim outputDir As String
Dim procSheet As String
Dim targetFileName As String
fileName = "C:\mswindows\downcast\input\demo.xml"
outputDir = "C:\mswindows\downcast\output\"
procSheet = ""
targetFileName = "C:\mswindows\downcast\output\demo.doc"
'
retVal = DCsetGlobalParameter("ConvertToDoc", "true")
retVal = DCconvertFile(fileName, outputDir, procSheet)

If (retVal = 0) Then
    MsgBox "Document successfully converted"
    
    '
    ' load the document
    '
    Documents.Open fileName:=targetFileName, ConfirmConversions:=False _
        , ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", _
        PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _
        WritePasswordTemplate:="", Format:=wdOpenFormatAuto
Else
    MsgBox "Error while converting document"
    Exit Sub
End If

End Sub