vba:SaveAs Use Corel WordPerfect to convert WP documents to HTML
WP2HTML "C:\Documents and Settings\MyUserID\My Documents\resume.wpd"
Sub WP2HTML( myFile )
' This subroutine opens a WordPerfect document,
' then saves it as HTML, and closes WordPerfect.
' If the HTML file exists, the subroutine will
' prompt for overwrite.
' If WordPerfect was already active, the subroutine
' will prompt the user to save the changes in other
' documents.
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com
' Standard housekeeping
Dim objFSO, objWP, objWPFile, strHTMLFile, strWPFile
Const WordPerfect_6_7_8_FileOpen_Format = 4
Const HTML_FileSave_ExportType = 226
Const No_FileSave_Overwrite = 0
Const Prompt_FileSave_Overwrite = 2
Const Yes_FileSave_Overwrite = 1
' Create a File System object
Set objFSO = CreateObject( "Scripting.FileSystemObject" )
' Create a WordPerfect OLE Automation object
Set objWP = CreateObject( "WordPerfect.PerfectScript" )
With objWP
' Check if the WordPerfect file exists
If objFSO.FileExists( myFile ) Then
Set objWPFile = objFSO.GetFile( myFile )
Else
WScript.Echo "FILE OPEN ERROR: The file does not exist" & vbCrLf
' Close WordPerfect
.ExitWordPerfect
Exit Sub
End If
strWPFile = objWPFile.Path
strHTMLFile = objFSO.BuildPath( objWPFile.ParentFolder, _
objFSO.GetBaseName( objWPFile ) & ".html" )
' Maximize the window
.AppMaximize
' Open the document
On Error Resume Next
.FileOpen strWPFile, WordPerfect_6_7_8_FileOpen_Format
If Err Then
WScript.Echo "FILE OPEN ERROR: " & Err.Number & vbCrLf _
& Err.Description & vbCrLf
Err.Clear
' Close WordPerfect
.ExitWordPerfect
Exit Sub
End If
' Save the document as HTML file
.FileSave strHTMLFile, HTML_FileSave_ExportType, Prompt_FileSave_Overwrite
If Err Then
WScript.Echo "FILE SAVE AS ERROR: " & Err.Number & vbCrLf _
& Err.Description & vbCrLf
Err.Clear
End If
' Close WordPerfect
.ExitWordPerfect
If Err Then
WScript.Echo "PROGRAM CLOSE ERROR: " & Err.Number & vbCrLf _
& Err.Description & vbCrLf
Err.Clear
End If
On Error Goto 0
End With
' Release the object
Set objWP = Nothing
End Sub