'' Convert WordPerfect files to Word format or PDF, using Word
'' Version 5.3.6 - 25 Aug 2010
'' By Edward Mendelson, http://wpdos.org
'' With many ideas taken from posts on VisualBasicScript.com
'' Described and downloadable from http://wpdos.org/converterscripts.html

'' Requires Windows 2000 or later, Microsoft Word 2000 or later.
'' Word 2003 or later required for converting multiple files
'' Word 2007 SP2 or later required for PDF export

Option Explicit

''''''''''''''''''''''''' USER-SELECTABLE OPTIONS ''''''''''''''''''''''''''''''''''''''''''''

''''' Export as PDF, not Word (.DOC) format ''''''

  '' This script can be set to create PDF files by default, instead of DOC files. 
  '' This feature requires Word 2007 SP2 or later. 
  '' To turn on this option, in the first line below, change PDFExport from "No" to "Yes".
    
  Dim PDFExport : PDFExport = "No"
  
  '' The PDFOpen variable determines whether or not a PDF file will open in your default
  '' PDF-reading program after being created. If you do NOT want the file to open after
  '' being created, then change PDFOpen from "Yes" to "No"
  
  Dim PDFOpen  : PDFOpen = "Yes"

''''' Option to turn off "processing takes time" prompt '''''

  '' If you want to turn off the prompt that says "File processing can take some time",
  '' change "on" to "off" (in quotation marks) in the line below. Default setting: "On"

  Dim TakesTimePrompt : TakesTimePrompt = "On"

''''' Option to turn off prompt when overwriting an existing file '''''

  '' IMPORTANT: If you want to turn off the prompt when overwriting existing files
  '' change "On" to "Off" (in quotation marks) in the line below this block.
  '' This option applies only for files or file specifications entered as 
  '' command-line parameters. It has no effect on filenames entered by filling in 
  '' a box when prompted for a filename. Default setting: "On"
  
  Dim PromptForOverwrite : PromptForOverwrite = "On"

''''' Font-Replacement Options ''''''
  
  '' This script can optionally correct some problems caused when Word assigns the wrong
  '' font or fonts to a converted document. If your documents use one font, and you want 
  '' Word to apply one font to the ENTIRE document, you must specify the "WholeFile" option
  '' below, and then (in another option below this one), you must also specify the font 
  '' (and optionally the point size) that you want Word to use
  
  '' If you want Word to replace up to three specific fonts in the converted document,
  '' then you must specify "MultiFont" in the line below, and then specify the fonts that
  '' you want Word to replace, in the separate section for the "MultiFont" option, about
  '' twenty lines below this one. The "MultiFont" option ONLY works if you ALSO specify 
  '' font names in the section below.
  
  '' If you want the script NOT to confirm that the replacement fonts that you specify are 
  '' installed on the system, change TestFontNames from "Yes" to "No".
  
  '' Options: FontMethod: "" (nothing inside the marks "") OR "WholeFile" OR "MultiFont"
  ''     Default setting: ""
  '' Options: TestFontNames: "Yes" (test fontnames) OR "No" (do not test fontnames)
  ''     Default setting: "Yes"

  Dim FontMethod : FontMethod = ""
  Dim TestFontNames : TestFontNames = "Yes"

''''' "WholeFile" option to reformat output file with one specific font '''''

  '' This setting takes effect ONLY if you have chosen the "WholeFile" option above.
  
  '' If you want Word to format your entire document with a specific font, you may specify 
  '' the font name and size in the two lines below. Type the name between quotation marks.
  '' The font size setting is OPTIONAL; if set at 0, Word will NOT change the font size.
  '' The font size setting will be applied ONLY if the font name is ALSO specified. 
  '' The setting NewFontSize = 14 will produce 14-point type in the converted document.
  '' Default settings are empty (nothing inside the two marks "") and 0.
  
  '' Example: Dim AllDocFont : AllDocFont = "Courier New"
  '' Example: Dim NewFontSize : NewFontSize = 0
  
  Dim AllDocFont : AllDocFont = ""
  Dim NewFontSize : NewFontSize = 0
  
''''' "MultiFont" option to replace up to three specific fonts in the output  file '''''

  '' This setting takes effect ONLY if you have chosen the "MultiFont" option above
  
  '' If Word replaces the fonts in your WordPerfect document with incorrect fonts, you
  '' may force it to correct its errors with the following settings. Remember that you
  '' must ONLY specify fonts that are listed in Word's font dialog, NOT fonts that are 
  '' listed in the WordPerfect font menus.

  '' In the first pair of variables below, enter next to BadFirstFont the name (inside
  '' quotation marks) of the font that Word mistakenly assigns. Then enter next to 
  '' NewFirstFont the name of the font that you want Word to use. REMEMBER THAT the 
  '' BadFirstFont MUST be the font that Word mistakenly assigns, which may or may not
  '' be the same font that you specified in your WordPerfect file. Use the Word fontname!
  
  '' If you wish to replace further fonts, enter their names in the second and third pairs
  '' of variables below. The second and third items are optional. If you wish to replace 
  '' only TWO fonts, be sure to use the BadSecondFont/NewSecontFont variables and leave 
  '' the Third set blank.

  Dim BadFirstFont : BadFirstFont = ""
  Dim NewFirstFont : NewFirstFont = ""
  
  Dim BadSecondFont : BadSecondFont = ""
  Dim NewSecondFont : NewSecondFont = ""
  
  Dim BadThirdFont : BadThirdFont = ""
  Dim NewThirdFont : NewThirdFont = ""

''''' Option to fine-tune Word's formatting of imported files '''''

  '' When Word imports a WordPerfect file, it makes minor format adjustments so that the
  '' converted Word file looks more as if formatted by WordPerfect. This script can
  '' make slight adjustments in Word's settings. These adjustments are turned off 
  '' in the script by default, but if turned on will slightly improve the appearance
  '' of some WPDOS6.x files, and can be manually adjusted by expert users.
  '' To turn on this option, change "Off" to "On" in line below (retain quotation marks).
  '' Default setting: "Off"

  Dim EnableFormatFix : EnableFormatFix = "Off"  
  
''''' Option to skip check for installed import filters '''''

  '' The script normally checks for the presence of Word's import two import filters
  '' for WordPerfect 5.x and WordPerfect 6.x and refuses to run if either of both 
  '' filters are not installed. If you do not want the script to test for these filters
  '' change "On" to "Off" in the line below (retain quotation marks). Default: "On"

  Dim CheckFiltersInstalled : CheckFiltersInstalled = "On"
  

''''''''''''''''''''''''' USAGE AND PARAMETERS ''''''''''''''''''''''''''''''''''''''''''''''

'' Usage: wp2msw.vbs [<input-filespec>] [default | <output-filespec>] [silent] [subdirs]

'' Parameters are optional, but if Parameter 2 is used, Parameter 1 is also required; 
''    if Paramater 3 is used, Parameters 1 and 2 are also required; 
''    if Parameter 4 is used, Parameters 1, 2, and 3 are also required

'' If Parameter 1 or 2 includes a path or filename with a space character, enclose the 
''    parameter in quotation marks

'' Parameter 1: either blank or <input-filespec>
''    <input-filespec> = full path of one file or a folder, or a wildcard specification
'' Parameter 2: either blank or 'default' or <output-filespec>
''   EITHER:
''     default = used to specify <input-filespec>.doc (or .pdf) as the output file name for 
''       an individual file, or to specify output directory when converting multiple files
''   OR:
''     <output-filespec> = when Parameter 1 is an individual file, Parameter 2 must be the 
''       full path of the converted output file; when Parameter 1 is a directory or 
''       wildcard specification, Parameter 2 must be the name of an existing directory 
''       for the converted output files
'' Parameter 3: either blank or 'silent' or 'PDF' or 'DOC' or 'silentPDF' or 'silentDOC'
''     silent = do not prompt except in case of error; when used with directories or wildcard
''       specifications, requires either 'default' or <output-filespec> as Parameter 2
''    PDF = force conversion to PDF format
''    DOC = force conversion to DOC format
''    silentPDF = force no-prompting conversion to PDF format
''    silentDOC = force no-prompting conversion to DOC format
'' Parameter 4: either blank or 'subdirs'
''     subdirs = when processing a directory or wildcard specification, also process
''       subdirectories;  requires 'default' as Parameter 2 and 'silent' as Parameter 3; 
''       if 'subdirs' is not specified subdirectories will not be processed 
''       during silent processing of a directory or wildcards

'''''''''''''''''''''''  END OF USER INFORMATION '''''''''''''''''''''''''''''''''''''''''''

''''''''''''''''''''''''''''''''''''''''''''''
'''' Declarations

Dim args, num, wpVer, wordVer, wordBuild, doDirs, numDirs, fName, fVer, arg2ext
Dim response, msgTxt, styleBtn, sUserIn, colSubfolders, lngJunk, rngStory
Dim oWord, oDoc, oFolder, oExplorer
Dim sInFile, sOutFile, sOutSpec, sOutDir, sOutExt, sFilename, sSDir, sWildspec
Dim sFileExt, sPDFOut, sDefaultExt, sApp, sVerb
Dim titleTxt : titleTxt = "Convert WP Files"
Dim wordOK : wordOK = 0
Dim pdfOK : pdfOK = 0
Dim bulkWP : bulkWP = 0
Dim fileCount : fileCount = 0
Dim checkCount : checkCount = 0
Dim notCount : notCount = 0
Dim default : default = 0
Dim silent : silent = 0
Dim subdirs : subdirs = 0
Dim overwrite : overwrite = 0
Dim inExists : inExists = 0
Dim useIE : useIE = 0
Dim replaceOK ': replaceOK = 0
Dim fixFormat ': fixFormat = 0
Dim ExtArray
ExtArray=Array(".DOC",".RTF",".BK!",".PDF",".ZIP",".DOCX",".XLS",".XLXS", + _
    ".PPT","PPTX",".DMG",".EXE")
Dim oFSO : Set oFSO = CreateObject("Scripting.FileSystemObject")
Dim WSHShell : Set WSHShell = WScript.CreateObject("WScript.Shell")
Dim CurDir : CurDir = oFSO.GetParentFolderName(Wscript.ScriptFullName)

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''' Main subroutines

ProgramsExist
SetUserOptions
GetFilenames
TestPdfOK
DisableWPFonts
WordVersionControl
SetIE
BranchRoutines
EndConv


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''' Preliminaries

Sub ProgramsExist
  ' Test whether Word and filters are installed
  On Error Resume Next
  Set oWord = CreateObject("Word.Application")
  If Err.Number <> 0 Then
    MsgBox "Error: Microsoft Word is not correctly installed on this system.", _
      vbOKOnly, titleTxt
      WScript.Quit
  End If
  oWord.Visible = False
  
  ' Test for Word version; requires 11 (2003) for WordPerfect detection
  wordVer = oWord.version
    If WordVer >= 11 Then
      wordOK = 1
    End If
  oWord.Quit 0
  On Error GoTo 0
    
  ' Test for correct PDF export variable
  Select Case LCase(PDFExport) 
    Case "yes" PDFExport = 1
    Case "no" PDFExport = 0
    Case Else
      MsgBox "Error: The PDFExport variable must be either 'Yes' or 'No'." + vbCR + _
      vbCR + "You entered: '" + pdfExport + "'.", vbOKOnly, titleTxt
      WScript.Quit
  End Select
  Select Case LCase(PDFOpen) 
    Case "yes" PDFOpen = 1
    Case "no" PDFOpen = 0
    Case Else
      MsgBox "Error: The PDFOpen variable must be either 'Yes' or 'No'." + vbCR + _
      vbCR + "You entered: '" + pdfOpen + "'.", vbOKOnly, titleTxt
      WScript.Quit
  End Select
  
  ' Test if import filters are installed
  If LCase(CheckFiltersInstalled) = "on" Then
    Dim WshProcEnv : Set WSHProcEnv = WSHShell.Environment("PROCESS")
    Dim sCmnPrgFiles : sCmnPrgFiles = WSHProcEnv("commonprogramfiles")
    Dim cnvFolder : cnvFolder = sCmnPrgFiles + "\Microsoft Shared\TextConv"
    Dim v5Cnv : v5Cnv = cnvFolder + "\wpft532.cnv"
    Dim v6Cnv : v6Cnv = cnvFolder + "\wpft632.cnv"
    Dim v5Found : v5Found = "False"
    Dim v6Found : v6Found = "False"
    If oFSO.FileExists(v5Cnv) Then
      v5Found = "True"
    End If
    If oFSO.FileExists(v6Cnv) Then
      v6Found = "True"
    End If
    If v5Found = "False" And v6Found = "False" Then
       MsgBox "Error: The required WP file converters are not installed on this system.", _
        vbOKOnly, titleTxt
         WScript.Quit
    End If
    If v5Found = "False" And v6Found = "True" Then
      MsgBox "The WordPerfect 5.x conversion filter for Microsoft Word is not " + _
         "installed." + vbCR + vbCR + "If you have no WordPerfect 5.x files to  " + _
         "convert you may safely turn off this message." + vbCR + vbCR + _
         "To turn off this message, change the 'CheckFiltersInstalled' option " +_
         "from 'On' to 'Off' in the script file.", vbOKOnly, titleTxt
    End If
    If v5Found = "True" And v6Found = "False" Then
       MsgBox "The WordPerfect 6.x conversion filter for Microsoft Word is not " + _
         "installed." + vbCR + vbCR + "If you have no WordPerfect 6.x files to  " + _
         "convert you may safely turn off this message." + vbCR + vbCR + _
         "To turn off this message, change the 'CheckFiltersInstalled' option " +_
         "from 'On' to 'Off' in the script file.", vbOKOnly, titleTxt
    End If
  End If
End Sub

Sub SetUserOptions
  If LCase(TakesTimePrompt) = "on" Then
  ElseIf LCase(TakesTimePrompt) = "off" Then
  Else
    MsgBox "Error: The TakesTimePrompt variable must be either 'On' or 'Off'." + vbCR + vbCR + _
        "You entered: '" + TakesTimePrompt + "'.", vbOKOnly, titleTxt
    WScript.Quit
  End If
  
  If LCase(PromptForOverwrite) = "off" Then
    replaceOK = 1
  ElseIf LCase(PromptForOverwrite) = "on" Then
    replaceOK = 0
  Else 
    MsgBox "Error: The PromptForOverwrite variable must be either 'On' or 'Off'." + vbCR + vbCR + _
        "You entered: '" + PromptForOverwrite + "'.", vbOKOnly, titleTxt
    WScript.Quit
  End If
  
  If LCase(EnableFormatFix) = "on" Then
    fixFormat = 1
  ElseIf LCase(EnableFormatFix) = "off" Then
    fixFormat = 0
  Else 
    MsgBox "Error: The EnableFormatFix variable must be either 'On' or 'Off'." + vbCR + vbCR + _
        "You entered: '" + EnableFormatFix + "'.", vbOKOnly, titleTxt
    WScript.Quit
  End If
  
  If PDFExport = 0 Then
      sDefaultExt = ".doc"
      sApp = "Word"
      sVerb = "convert"
      titleTxt = "Convert WP Files To Word"
    ElseIf PDFExport = 1 Then
      sDefaultExt = ".pdf"
      sApp = "PDF"
      sVerb = "export"
      titleTxt = "Export WP Files to PDF"
  End If
  
  If FontMethod <> "" Then 
    If LCase(FontMethod) <> "wholefile" Then
      If LCase(FontMethod) <> "multifont" Then
        MsgBox "Error: The FontMethod variable must be either blank" + vbCR + _
        "or 'WholeFile' or 'MultiFont'." + vbCR + vbCR + _
        "You entered: '" + FontMethod + "'.", vbOKOnly, titleTxt
        WScript.Quit
      End If
    End If
  End If
  ' Test for accuracy of fontnames
  If LCase(TestFontNames) = "yes" Then
       FontInstalled(AllDocFont)
       FontInstalled(NewFirstFont)
       FontInstalled(NewSecondFont)
       FontInstalled(NewThirdFont)
  End If
End Sub

Sub GetFilenames
  ' Get command-line parameters
  Set args = WScript.Arguments
  num = args.Count
  
  If num = 0 Then
      userPmt
  End If
  
  ' Parameter 1 can be file or folder or wildcard
  If num >= 1 Then
      sInFile = args.Item(0)
      
      ' clean up filespec by removing final dot if present
       If Right(sInFile,1) = "." Then
          Dim newLen : newLen = Len(sInFile) - 1
          sInFile = Left(sInFile,newLen)
       End If
       
       ' assume filespec in script directory if no path entered
       If InStr(sInFile, "\") = 0 Then
           sInFile = CurDir + "\" + sInFile
       End If
                  
      If oFSO.FileExists(sInFile) Then
          fName = oFSO.GetFileName(sInFile)
          sOutFile = sInFile + sDefaultExt
      Else
        If oFSO.FolderExists(sInFile) Then
          sSDir  = sInFile
          sOutDir = sSDir
          bulkWP = 1 
         Else
          sSDir = CheckWildcard(sInFile)
          sOutDir = sSDir
          If bulkWP <= 1 Then
            MsgBox "Error: The specified file or folder does not exist.", _
            vbOKOnly, titleTxt
             WScript.Quit
           End If
        End If
      End If
  End If
  
  ' Parameter 2 is either "default", a filename, or an output directory
  If num >= 2 Then 
       sOutSpec = args.Item(1)
 
       ' Avoid error when two files dropped on script
       If oFSO.FileExists(sOutSpec) Then
         MsgBox "Possible error: " + vbCR + vbCR + "I think you may have dropped " + _
           "multiple files on this script, or, on  " + vbCR + _
           "the command line, you specified an existing file as the output file. " + _
           vbCr + vbCr +"Please drop only one file, or, to prevent errors, do not specify " + _
           vbCR + "an existing file as the output file.", vbOKOnly, titleTxt
         WScript.Quit
       End If

      If LCase(sOutSpec) = "default" Then
         default = 1
      Else

      'replace illegal characters  < > : " /  | ? * with underscore
      sOutSpec = Clean(sOutSpec)

      'force conversion type according to output file extension
      If LCase(Right(sOutSpec,4)) = ".doc" Then
            PDFExport = 0
            arg2ext = "doc"
      ElseIf LCase(Right(sOutSpec,4)) = ".pdf" Then
            PDFExport = 1
            arg2ext = "pdf"
      End If
  
      ' assume filespec in script directory if no path entered
          If InStr(sOutSpec, "\") = 0 Then
            sOutSpec = CurDir + sOutSpec
          End If
  
        If bulkWP = 0 Then
          If oFSO.FolderExists(sOutSpec) Then
             FixMultsOutFile(sOutSpec)
          Else
            sOutFile = sOutSpec
          End If
        End If
        If bulkWP >= 1 Then
          If oFSO.FolderExists(sOutSpec) Then
            sOutDir = sOutSpec
              If bulkWP = 2 Then
                bulkWP = 4
              Else
                bulkWP = 3
            End If
          Else
            MsgBox "Error: When processing multiple files Parameter 2 must be an " + _
              "existing folder.", vbOKOnly, titleTxt
             WScript.Quit
           End If
        End If
      End If
  End If
  
  ' Parameter 3 "silent" means no prompting except for errors
  If num >= 3 Then
      Dim Param3OK : Param3OK = 0
      'If args.Item(2) = "silent" Then
      If InStr(LCase(args.Item(2)), "silent") <> 0  Then
          Param3OK = 1
          If replaceOK = 0 Then
            
            ' allow "forcesilent" to override IgnoreSilent
            ' this isn't mentioned in the documentation
            If InStr(LCase(args.Item(2)), "force") = 0  Then
              IgnoreSilent
              silent = 0
            ElseIf InStr(LCase(args.Item(2)), "force") <> 0  Then
              replaceOK = 1
              silent = 1
            End If
            
          Else
            silent = 1
          End If
      End If
      If InStr(UCase(args.Item(2)), "PDF") <> 0 Then
          Param3OK = 1
          PDFExport = 1
          If arg2ext = "doc" Then
            MsgBox "Error: Output filename specifies Word export, but Parameter 3 specifies PDF." + _
              vbCR + vbCR + "Please use consistent command-line parameters.", vbOKonly, titleTxt
            WScript.Quit
          End If
        ElseIf InStr(UCase(args.Item(2)), "DOC") <> 0 Then
          Param3OK = 1
          PDFExport = 0
          If arg2ext = "pdf" Then
            MsgBox "Error: Output filename specifies PDF export, but Parameter 3 specifies DOC." + _
              vbCR + vbCR + "Please use consistent command-line parameters.", vbOKonly, titleTxt
            WScript.Quit
          End If
      End If
       If Param3OK = 0 Then
        MsgBox "Parameter 3 must be either blank or any of the following:" + vbCR + vbCR +  _
          "   PDF, DOC, silent, silentPDF, silentDOC" + vbCR + vbCR + "You entered " + _ 
              Chr(34) + args.Item(2) + Chr(34) + ".", _
        wScript.Quit
      End If
    End If
  ' Parameter 4 must be "subdirs" for use when processing a directory of files
  If num = 4 Then
      If args.Item(3) = "subdirs" Then
        If bulkWP >= 3 Then
          IgnoreSubdirs
        Else
          subdirs = 1
        End If 
      Else
        MsgBox "Parameter 4 must be " + Chr(34) + "subdirs" + Chr(34) + " or blank." + _
          vbCR + vbCR + "You entered " + Chr(34) + args.Item(3) + Chr(34) + ".", _
          vbOKOnly, titleTxt
        wScript.Quit
      End If
  End If
  If num >= 5 Then
      MsgBox "Too many command-line parameters.", _
          vbOKOnly, titleTxt
      wScript.Quit
  End If
End Sub

Sub TestPdfOK
If PDFExport = 1 Then
    Set oWord = CreateObject("Word.Application")
    If WordVer <= 11 Then
      MsgBox "Error: PDF Export requires Word 2007 SP2 or later.", _
      vbOKOnly, titleTxt
      oWord.Quit
      WScript.Quit
    End If
    ' Word 2007 SP2 installs PDF exporter
    If WordVer = 12 Then 
      wordBuild = oWord.Build
      Dim buildNum : buildNum = Right((wordBuild),4)
      If buildNum >= 6504 Then
          pdfOK = 1
      Else
          MsgBox "Error: PDF Export requires Word 2007 SP2 or later.", _
          vbOKOnly, titleTxt
          oWord.Quit
          WScript.Quit
      End If
    End If
    ' Word 2010 and later have PDF export
    If WordVer >= 13 Then
      pdfOK = 1
    End If
    oWord.Quit
  End If
  If PDFExport = 0 Then
      sDefaultExt = ".doc"
      sApp = "Word"
      sVerb = "convert"
      titleTxt = "Convert WP Files To Word"
    ElseIf PDFExport = 1 Then
      sDefaultExt = ".pdf"
      sApp = "PDF"
      sVerb = "export"
      titleTxt = "Export WP Files to PDF"
  End If
End Sub

Sub DisableWPFonts
  ' Undocumented registry entries to prevent Word from using 
  '    WPTypographicSymbols and similar fonts if installed
  WSHShell.RegWrite "HKLM\Software\Microsoft\Shared Tools\Text " + _ 
    "Converters\Import\WordPerfect6x\Options\NoWPFonts", "Yes", "REG_SZ"
  WSHShell.RegWrite "HKLM\Software\Microsoft\Shared Tools\Text " + _
    "Converters\Import\WrdPrfctDos\Options\NoWPFonts", "Yes", "REG_SZ"
End Sub

Sub SetIE
  If Silent = 0 Then
    If BulkWP >= 1 Then
      Set oExplorer = WScript.CreateObject("InternetExplorer.Application")
      useIE = 1
    End If
  End If
End Sub

Sub WordVersionControl
' If processing multiple files (bulkWP >= 1) then require Word 2003 or later
If bulkWP >= 1 Then
  If wordOK = 0 Then
    bulkWP = 0
    Dim wordName
    Select Case wordVer 
      Case 9 wordName = "2000"
      Case 10 wordName = "2002 (Word XP)"
      Case Else 
        MsgBox "This script does not work with Word 97 or earlier.", vbOKOnly, titleTxt
        wScript.Quit
    End Select
    MsgBox "On a system with Word " + wordName + ", this script will convert only " + _
        "one file at a time." + vbCR + vbCR + _
        "Please run the script again to convert a single file.", vbOKOnly, titleTxt
    wScript.Quit
  End If
End If
End Sub

Sub BranchRoutines
  ' Test for bulkWP variable that tells what kind of operation to perform
  Select Case bulkWP
    ' 0 = process one file only
    Case 0 
      MsgOneFile
      If PDFExport = 0 Then
        ConvWPDoc
      ElseIf PDFExport = 1 Then
        ConvWPToPDF
      End If
    ' 1 = process directory full of files to same folder
    Case 1 
      CountDirs oFSO.GetFolder(sSDir)
      AskContinue
      RunIE 
      CheckOutDir
      DirWalk oFSO.GetFolder(sSDir), oFSO.GetFolder(sOutDir)
      StopIE 
      ' 2 = process wildcard specification to same folder
    Case 2 
      CountDirs oFSO.GetFolder(sSDir)
      AskContinueWild
      RunIE
      CheckOutDir
      DirWalkWild oFSO.GetFolder(sSDir), oFSO.GetFolder(sOutDir)
      StopIE 
    ' 3 = process directory full of files to a different output folder
    Case 3
      AskContinueMove
      RunIE
      CheckOutDir
      DirWalkMove oFSO.GetFolder(sSDir), oFSO.GetFolder(sOutDir)
      StopIE
    ' 4 = process wildcard specification to a different output folder
    Case 4
      AskContinueMoveWild
      RunIE
      CheckOutDir
      DirWalkMoveWild oFSO.GetFolder(sSDir), oFSO.GetFolder(sOutDir)
      StopIE
    End Select
End Sub

Sub userPmt
  ' if no command-line parameters, prompt user for input file or folder or filespec
  Do While inExists = 0
  If wordOK = 1 Then
    msgTxt = "Enter filename, directory name, or wildcard specification of " + _
      "files to " + sVerb + " to " + sApp + " format. " + vbCR + vbCR + _
      "This script converts WordPerfect files only."
  Else     ' use different prompt for Word 2000/2002 and process one file only
    msgTxt = "Enter name of file to convert to Word format. " + vbCR + vbCR 
  End If
    sInFile = InputBox(msgTxt, titleTxt, "")
    If Len(sInFile)  = 0 Then
      wscript.Quit
    End If
  
  ' clean up filespec by removing final dot if present
  If Right(sInFile,1) = "." Then
    Dim newLen : newLen = Len(sInFile) - 1
    sInFile = Left(sInFile,newLen)
  End If
  
  ' assume filespec in script directory if no path entered
  If InStr(sInFile, "\") = 0 Then
    sInFile = CurDir + sInFile
  End If
    
 ' if input file exists, assign default name to output file
  If oFSO.FileExists(sInFile) Then
      bulkWP = 0
      inExists = 1
      sOutFile = sInFile + sDefaultExt
    Else 
    ' if input folder exists, proceed
    If oFSO.FolderExists(sInFile) Then
        sSDir  = sInFile
         inExists = 1
        bulkWP = 1 
       Else
         ' test for wildcard filespec
        sSDir = CheckWildcard(sInFile)
        If bulkWP <= 1 Then
          response = MsgBox("Error: The specified file or folder does not exist. " + _
              "Please try again.", vbOK, titleTxt)
           If response = vbCancel Then
               WScript.Quit
          End If 
         End If
    End If
  End If 
  Loop
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''' Procedures for converting one file

Sub msgOneFile
  ' replace illegal characters
  sOutFile = Clean(sOutFile)
  ' test for .doc extension, add if needed
  sOutExt = LCase(Right(sOutFile, 4))
  If sOutExt <> sDefaultExt Then
    sOutFile = sOutFile + sDefaultExt
  End If
  ' prompt to change name of output file if desired
  If silent = 0 Then
    If default = 0 Then
      msgTxt = "The file " + UCase(sInFile) + " will be " + sVerb + "ed" + _
          " to " + sApp + " file" + vbCR + vbCR + sOutFile + vbCR + vbCR + _
          "Use different filename for " + sVerb + "ed file?"
      styleBtn = VBYesNoCancel Or VBDefaultButton2 Or VBInformation
      response = MsgBox(msgTxt, StyleBtn, titleTxt)
        If response = VBYes Then
          GetsOutFile(sFilename)
          Else
            If response = VBCancel Then
                CancelQuit
            End If
        End If
    End If
  End If
  ' test for forbidden match of input and output filenames 
  Do While UCase(sInFile) = UCase(sOutFile)
  msgTxt = "Source file and converted file must have different names." 
  styleBtn = VBOK Or VBCritical
  response = MsgBox(msgTxt, StyleBtn, titleTxt)
    If response = VBCancel Then
      wScript.Quit
    End If
    GetsOutFile(sFilename)
     If Len(sOutFile)  = 0 Then
      wscript.Quit
    End If
  Loop
  ' test whether specified output file already exists
  If silent = 0 Then
    Do While overwrite = 0
      If oFSO.FileExists(sOutFile) Then
      msgTxt = "Output file " + sOutFile + " already exists!" + vbCR _
            + vbCR + "Overwrite existing file?"
        styleBtn = VBYesNoCancel or VBDefaultButton2 or VBExclamation
        response = MsgBox(msgTxt, styleBtn, titleTxt)
        Select Case response
        Case VBCancel 
          wScript.Quit
        Case VBYes 
          overwrite = 1
        Case VBNo 
          getsOutFile(sFilename)
        End Select
      Else
        overwrite = 1
      End If
    Loop
  End If
End Sub

Sub ConvWPDoc
  Set oWord = CreateObject("Word.Application")
  oWord.Visible = False
  If silent = 0 Then
    If LCase(TakesTimePrompt) = "on" Then
      response = MsgBox("File processing may take some time. " + _
      "Press OK, and please wait.", vbOK, titleTxt)
      If response = vbCancel Then
        wScript.Quit
      End If
    End If
  End If
  
  'save autoopen etc. settings, and turn off for this file
    Dim secAutomation
    If WordOK = 1 Then 
      secAutomation = oWord.AutomationSecurity
      oWord.AutomationSecurity = 3
    End If
    
   'save confirm conversion at open setting and turn off for this file
    Dim confConversion
      confConversion = oWord.Options.ConfirmConversions
      If confConversion = True Then
        oWord.Options.ConfirmConversions = False
      End If  
  
  Set oDoc = oWord.Documents.Open(sInFile, , True)
  Set oDoc = oWord.ActiveDocument
  If FontMethod <> "" Then 
        FontReplace oDoc 
  End If
  If WordOK = 1 Then
    
    fVer = oWord.WordBasic.FileVersion
    If InStr(UCase(fVer), UCase("WordPerfect")) Then
      If InStr(fVer, "6.x") Then
           wpVer = 6
         Else
           wpVer = 5
       End If
       
       If fixFormat = 1 Then
         AdjustFormat(oDoc)
       End If
              
      oDoc.SaveAs sOutFile, 0
      'restore autoopen etc. setting
      oWord.AutomationSecurity = secAutomation
      
      'restore confirm conversion setting
       If confConversion = True Then
        oWord.Options.ConfirmConversions = True
      End If  
          
      If silent = 0 Then
        msgTxt = "Converted file saved as " + sOutFile + vbCR + vbCR + _
          "Open converted file for editing in Word?"
        styleBtn = VBYesNo Or VBDefaultButton2 Or VBInformation
        response = MsgBox(msgTxt, styleBtn, titleTxt)
        If response = VBNo Then
             oWord.Quit 0
             wScript.Quit
          Else
             oWord.visible = True
             WSHShell.AppActivate("Microsoft Word")
        End If
      Else
          oWord.Quit 0
           wScript.Quit
      End If
    Else
       MsgBox "Error: " + UCase(sInFile) + " is not a WordPerfect file." + vbCR + vbCR + _
         "It has not been converted to Word format.", vbOKOnly, titleTxt
      oWord.Quit 0
       wScript.Quit
    End If
    
  ElseIf wordOK = 0 Then
  ' don't test for WordPerfect file format in Word 2000/2002
      
      If fixFormat = 1 Then
        wpVer = 5
         AdjustFormat(oDoc)
       End If
       
       oDoc.SaveAs sOutFile, 0
     
     'restore autoopen etc. setting - not for Word 2000, XP
     'oWord.AutomationSecurity = secAutomation
  
      If silent = 0 Then
        msgTxt = "Converted file saved as " + sOutFile + vbCR + vbCR + _
          "Open converted file for editing in Word?"
        styleBtn = VBYesNo Or VBDefaultButton2 Or VBInformation
        response = MsgBox(msgTxt, styleBtn, titleTxt)
        If response = VBNo Then
             oWord.Quit 0
             wScript.Quit
          Else
             oWord.visible = True
             WSHShell.AppActivate("Microsoft Word")
        End If
      Else
          oWord.Quit 0
           wScript.Quit
      End If
  End If
End Sub

Sub ConvWPToPDF
  Set oWord = CreateObject("Word.Application")
  oWord.Visible = False
  If silent = 0 Then
    If LCase(TakesTimePrompt) = "on" Then
      response = MsgBox("File conversion may take some time. Press OK, and please wait.", _
        vbOK, titleTxt)
      If response = vbCancel Then
        wScript.Quit
      End If
    End If
  End If
  
  'save autoopen etc. settings, and turn off for this file
     Dim secAutomation
     If WordOK = 1 Then 
      secAutomation = oWord.AutomationSecurity
      oWord.AutomationSecurity = 3
    End If
  
  Set oDoc = oWord.Documents.Open(sInFile, , True)
  Set oDoc = oWord.ActiveDocument
  If FontMethod <> "" Then 
      FontReplace oDoc 
  End If
  If WordOK = 1 Then
    
    fVer = oWord.WordBasic.FileVersion
    If InStr(UCase(fVer), UCase("WordPerfect")) Then
      If InStr(fVer, "6.x") Then
           wpVer = 6
         Else
           wpVer = 5
       End If
       
       If fixFormat = 1 Then
         AdjustFormat(oDoc)
       End If
       
       sPDFOut = Left(sOutFile, Len(sOutFile) -4)
      oDoc.ExportAsFixedFormat sPDFOut + sDefaultExt, 17, PDFOpen
  
      'restore autoopen etc setting
       oWord.AutomationSecurity = secAutomation
  
      oWord.Quit 0
      wScript.Quit
      
    Else
       MsgBox "Error: " + UCase(sInFile) + " is not a WordPerfect file." + vbCR + vbCR + _
         "It has not been exported to PDF format.", _
         vbOKOnly, titleTxt
      oWord.Quit 0
       wScript.Quit
    End If
  End If

End Sub

Function GetsOutFile(sFilename)
' when converting one file, give user chance to change name of output file
  sUserIn = InputBox("Enter path and filename for converted file." + vbCR + vbCR + _
         "Use the filename extension " + sDefaultExt + ". If you omit the " + _
         sDefaultExt + " extension, " +  "it will be added automatically.", _
         titleTxt, sOutFile)
  If Len(sUserIn)  = 0 Then
    wscript.Quit
  End If
  sOutFile = sUserIn
  sOutFile = Clean(sOutFile)
  ' add .doc extension if not already present
  sOutExt = LCase(Right(sOutFile, 4))
  If sOutExt <> sDefaultExt Then
    sOutFile = sOutFile + sDefaultExt
  End If
End Function

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''' Procedures for converting files in folders

Sub AskContinue
  If sOutFile <> "" Then
    If sOutFile <> "default" Then
      IgnoreParam
    End If
  End If
  If silent = 0 Then
  MsgTxt = "This script " + sVerb + "s to " + sApp + " format all WP files " + _
      "in this directory:" + vbCR + vbCR + "  " +  sSDir + vbCR + vbCR + _
      "The " + sVerb + "ed files will have the same name as the originals," + _
      vbCR + "with a " + sDefaultExt + " extension added to the original " + _
      "name and extension." + vbCR + vbCR + _
      "The original files will not be changed (but see Warning below)." + vbCR + vbCR + _
      "Warning: If this directory includes a WP file named MYFILE1" + vbCR + _
      "and a file named MYFILE1" + sDefaultExt + ", then the original MYFILE1" + _
      sDefaultExt + vbCR + "will be overwritten during conversion." + vbCR + vbCR + _
      "Files with these extensions will not be processed:" + vbCR + _ 
      "  .BK!, .DOC, .DOCX, .EXE, .PDF, .XLS, .XLXS, .ZIP" + vbCR + vbCR + _
      "Processing may take a long time. Continue?"
  response = MsgBox(MsgTxt, vbOK, titleTxt)
    If response = vbCancel Then
      wScript.Quit
    End If
    If numDirs > 0 Then
      response = MsgBox("Also " + sVerb + " files in subdirectories?", _
        vbYesNoCancel Or vbDefaultButton2, titleTxt)
      If response = vbCancel Then
        wScript.Quit
      End If
      If response = vbYes Then
      doDirs = 1
      End If
    End If
  End If
  If silent = 1 Then
    If subdirs = 1 Then
      doDirs = 1
    End If
  End If
End Sub
    
Sub CheckOutDir
  If sOutDir = "" Then
    sOutDir = sSDir
  End If
End Sub
    
Sub DirWalk(oDir, sOutDir)
    Dim oFiles : Set oFiles = oDir.Files
    Dim oFile
    For Each oFile In oFiles
    '  checkCount = checkCount + 1
      If UseIE = 1 Then
        WaitIE
      End If
      ' test file extensions
        sFileExt = Right(UCase(oFile.Name),4)
        If InArray(sFileExt,ExtArray) = False Then 
          sFileExt = Right(UCase(oFile.Name),5)  
          If InArray(sFileExt,ExtArray) = False Then 
            If PDFExport = 0 Then
              OpenAndSave oFile, sOutDir
            ElseIf PDFExport = 1 Then
              OpenAndExportPDF oFile, sOutDir
            End If
        End If
      End If
    Next
   If DoDirs = 1 Then
      Dim oSubDs : Set oSubDs = oDir.SubFolders
      Dim oSubD
      For Each oSubD In oSubDs
        sOutDir = oSubD
        DirWalk oSubD, sOutDir
      Next
    End If
  End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''' Procedures for wildcards

Sub AskContinueWild
  If sOutFile <> "" Then
    If sOutFile <> "default" Then
      IgnoreParam
    End If
  End If
  If silent = 0 Then
    MsgTxt = "This script " + sVerb + "s to " + sApp + " format all WP files named" + _
      vbCR + vbCR + "  " + sWildSpec + vbCR + vbCR + "in this directory:" + _
      vbCR + vbCR + "  " +  sSDir + vbCR + vbCR + _
      "The " + sVerb + "ed files will have the same name as the originals," + _
      vbCR + "with a " + sDefaultExt + " extension added to the original name " + _ 
      "and extension." + vbCR + vbCR + _
      "The original files will not be changed (but see Warning below)." + vbCR + vbCR + _
      "Warning: If this directory includes a WP file named MYFILE1" + vbCR + _
      "and a file named MYFILE1" + sDefaultExt + ", then the original MYFILE1" + _
      sDefaultExt + vbCR + "will be overwritten." + vbCR + vbCR + _
      "Files with these extensions will not be processed:" + vbCR + _ 
      "  .BK!, .DOC, .DOCX, .EXE, .PDF, .XLS, .XLXS, .ZIP" + vbCR + vbCR + _
      "Processing may take a long time. Continue?"
    response = MsgBox(MsgTxt, vbOK, titleTxt)
    If response = vbCancel Then
      wScript.Quit
    End If
    If numDirs > 0 Then
      response = MsgBox("Also " + sVerb + "files in subdirectories?", _
        vbYesNoCancel Or vbDefaultButton2, titleTxt)
      If response = vbCancel Then
        wScript.Quit
      End If
      If response = vbYes Then
        doDirs = 1
      End If
    End If
  End If
  If silent = 1 Then
    If subdirs = 1 Then
      doDirs =1
    End If
  End If
End Sub
    
Sub DirWalkWild( oDir, oMove )
    Dim oFiles : Set oFiles = oDir.Files
    Dim oFile
    For Each oFile In oFiles
    '  checkCount = checkCount + 1
      If UseIE = 1 Then
        WaitIE
      End If
      If FileMatchesPattern(oFile.name, sWildSpec) Then
        ' test file extensions
        sFileExt = Right(UCase(oFile.Name),4)
        If InArray(sFileExt,ExtArray) = False Then 
          sFileExt = Right(UCase(oFile.Name),5)  
          If InArray(sFileExt,ExtArray) = False Then 
             If PDFExport = 0 Then
              OpenAndSave oFile, sOutDir
            ElseIf PDFExport = 1 Then
              OpenAndExportPDF oFile, sOutDir
            End If
          End If
        End If
      End If
     Next
    If DoDirs = 1 Then
      Dim oSubDs : Set oSubDs = oDir.SubFolders
      Dim oSubD
      For Each oSubD In oSubDs
        sOutDir = oSubD
        DirWalkWild oSubD, sOutDir
      Next
    End If
  End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''' Procedures for converting files in folders to another folder

Sub AskContinueMove
  If silent = 0 Then
  MsgTxt = "This script " + sVerb + "s to " + sApp + " format all WP files "+ _
      "in this directory:" + vbCR + vbCR + "  " +  sSDir + vbCR + vbCR + _
      "The " + sVerb + "ed files will be written to this directory:" + _ 
      vbCR + vbCR + "  " + sOutDir + vbCR + vbCR + _
      "The " + sVerb + "ed files have the same name as the originals," + vbCR + _
      "with " + sDefaultExt + " appended to the original name and extension." + _
      vbCR + vbCR +  "Subdirectories will not be processed." + vbCR + vbCR + _
      "Warning: Processing will overwrite any existing files in" + vbCR + _ 
      + sOutDir + " that have the same names as the output files." + vbCR + vbCR + _
      "Files with these extensions will not be processed:" + vbCR + _ 
      "  .BK!, .DOC, .DOCX, .EXE, .PDF, .XLS, .XLXS, .ZIP" + vbCR + vbCR + _
      "Processing may take a long time. Continue?"
  response = MsgBox(MsgTxt, vbOK, titleTxt)
    If response = vbCancel Then
      wScript.Quit
    End If
  End If
End Sub
    
Sub DirWalkMove(oDir, oMove)
    Dim oFiles : Set oFiles = oDir.Files
    Dim oFile
    For Each oFile In oFiles
    '  checkCount = checkCount + 1
      If UseIE = 1 Then
        WaitIE
        End If
        ' test file extensions
          sFileExt = Right(UCase(oFile.Name),4)
          If InArray(sFileExt,ExtArray) = False Then 
            sFileExt = Right(UCase(oFile.Name),5)  
            If InArray(sFileExt,ExtArray) = False Then 
               If PDFExport = 0 Then
              OpenAndSave oFile, sOutDir
            ElseIf PDFExport = 1 Then
              OpenAndExportPDF oFile, sOutDir
            End If
          End If
        End If
      Next
End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''' Procedures for converting wildcards to a different folder

Sub AskContinueMoveWild
  If silent = 0 Then
    MsgTxt = "This script " + sVerb + "s to " + sApp + " format all WP files named" _
      + vbCR + vbCR + "  " + sWildSpec + vbCR + vbCR + "in this directory:" + _
      vbCR + vbCR + "  " +  sSDir + vbCR + vbCR + _
      "The " + sVerb + "ed files will be written to this directory:" + _ 
      vbCR + vbCR + "  " + sOutDir + vbCR + vbCR + _
      "The " + sVerb + "ed files have the same name " + "as the originals," + vbCR + _
      "with " + sDefaultExt + "appended to the original name and extension." + _
      vbCR + vbCR +  "Subdirectories will not be processed." + vbCR + vbCR + _
      "Warning: Processing will overwrite any existing files in" + vbCR + _ 
      + sOutDir + " with the same names as the output files." + vbCR + vbCR + _
      "Files with these extensions will not be processed:" + vbCR + _ 
      "  .BK!, .DOC, .DOCX, .EXE, .PDF, .XLS, .XLXS, .ZIP" + vbCR + vbCR + _
      "Processing may take a long time. Continue?"
    response = MsgBox(MsgTxt, vbOK, titleTxt)
    If response = vbCancel Then
      wScript.Quit
    End If
  End If
  If silent = 1 Then
  End If
End Sub
    
Sub DirWalkMoveWild(oDir,oMove )
    Dim oFiles : Set oFiles = oDir.Files
    Dim oFile
    For Each oFile In oFiles
    '  checkCount = checkCount + 1
      If UseIE = 1 Then
        WaitIE
      End If
       If FileMatchesPattern(oFile.name, sWildSpec) Then
        ' test file extensions
        sFileExt = Right(UCase(oFile.Name),4)
        If InArray(sFileExt,ExtArray) = False Then 
          sFileExt = Right(UCase(oFile.Name),5)  
          If InArray(sFileExt,ExtArray) = False Then 
             If PDFExport = 0 Then
              OpenAndSave oFile, sOutDir
            ElseIf PDFExport = 1 Then
              OpenAndExportPDF oFile, sOutDir
            End If
          End If
        End If
      End If
    Next
 End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''' Shared subs and functions

Sub CountDirs(oDir)
  Set oFolder = oFSO.GetFolder(sSDir)
  Set colSubfolders = oFolder.Subfolders
  numDirs = colSubfolders.Count
End Sub

Sub EndConv
  If bulkWP <> 0 Then
    If silent = 0 Then
      Select Case fileCount
        Case 0
          MsgBox "No files were converted.", , titleTxt
        Case 1
          MsgBox "One file converted.", , titleTxt
        Case Else
          MsgBox CStr(fileCount) + " files converted.", , titleTxt
      End Select
    End If
  End If
  wScript.Quit
End Sub

Function FixMultsOutFile(sFilename)
  Dim outFirst : outFirst = sOutSpec
  If Right(sOutSpec, 1) <> "\" Then
      sOutSpec = sOutSpec + "\"
  End If
  sUserIn = InputBox("Error: " + outFirst + " is a directory name." + vbCR + vbCR +_
        "I think you want to use the output filename specified below, "+ _
        "but you may change it if you prefer." + vbCR + vbCR + _
        "Use the filename extension .doc. If you omit the .doc extension, " + _
        "it will be added automatically.", titleTxt, sOutSpec + fName + ".doc")
  If Len(sUserIn)  = 0 Then
    wscript.Quit
  End If
  sOutFile = sUserIn
  sOutExt = LCase(Right(sOutFile, 4))
  If sOutExt <> sDefaultExt Then
    sOutFile = sOutFile + sDefaultExt
  End If
End Function

Function CheckWildcard(strIn)
  Dim wildPos, wildLen, slantPos, dirLen
  wildPos = InStr(sInFile, "*")
  If wildPos = 0 Then
    wildPos = InStr(sInFile, "?")
  End If
  If wildPos <> 0 Then
    sInFile = Trim(sInFile)
    slantPos = InStrRev(sInFile, "\")
    wildLen = Len(sInFile) - SlantPos
    sWildSpec = Right(sInFile, wildLen)
    dirLen = Len(sInFile) - wildLen
    sSDir = Left(sInFile, dirLen)
    inExists = 1
    bulkWP = 2
    CheckWildcard = sSDir
  End If
End Function

Function clean(strToClean)
'Source: http://www.code-tips.com, with modifications by EM
'Remove illegal characters ?:*?"<>
Dim charArray : charArray = Array("?","/","*","""","<",">","|")
Dim arraySize : arraySize = UBound(charArray) 'get the size of the character array
Dim tmpstr : tmpstr = strToClean 'store string in tempporary variable
Dim cont : cont = True 'repeat string check for current character
Dim current : current = 0 'store current array index
'Loop through illegal character array until all illegal chars removed from string
Dim charAt, leftPart, rightPart
Dim charChanged : charChanged = 0
While cont
   charAt = InStr(tmpstr,charArray(current))
    'msgbox (charAt)
   If (charAt > 0) Then
      leftPart = Left(tmpstr, charAt-1)
      rightPart = Mid(tmpstr, charAt+1, Len(tmpstr))
       'If charArray(current) = ":" Then
       '     tmpstr = leftPart & "-" & rightPart
        ' Else
            tmpstr = leftPart & "_" & rightPart
            charChanged = 1
      'End If
      'msgbox (leftPart)
         'msgbox (rightPart)
         'msgbox (tmpstr)
   Else 'Character not found in string
      If current < arraySize Then
         'Increment
         current = current + 1
      Else
         cont = False
      End If
   End If
Wend
'Remove any : after 2nd character
If InStr(3, tmpstr, ":") > 0  Then 
  tmpstr = Left(tmpstr,2) + Replace(tmpstr, ":", "_", 3)
  charChanged = 1
End If
If charChanged = 1 Then
  response = MsgBox("The specified filename includes one or more characters " + _
      "that cannot be used" + vbCR + "in filenames. " + _
      "This script replaces these illegal characters with underscores." + vbCR + vbCr +  _
      "The name you entered will be corrected to: " + vbCR + vbCR + tmpstr + vbCR + vbCR + _ 
      "Press Cancel if you prefer to quit without saving the output file.", _
      vbOK, titleTxt)
  If response = vbCancel Then
      WScript.Quit
  End If 
End If
'Return the cleaned string
clean = tmpstr
End Function

Sub IgnoreParam
  response = MsgBox("Specified output file specification (" + Chr(34) + _ 
    sOutSpec + Chr(34) + ")" + vbCR + _
    "will be ignored when processing multiple files." + vbCR + vbCR + _
    "For multiple files, either use " + chr(34) + "default" + chr(34) + _
    " as output" + vbCR + "file specification, or leave Parameter 2 blank." + _
    vbCR + vbCR + "Press OK to continue with multiple-file conversion.",_
    vbOK, titleTxt)
  If response = vbCancel Then
        wScript.Quit
  End If
End Sub

Sub IgnoreSilent
  response = MsgBox("The 'silent' parameter may be used only when the " + _
      "PromptForOverwrite " + vbCR + "option is marked 'off' in the script file." + _
      vbCR + vbCR + "You must edit the script file by hand to change this option." + _
      vbCR + vbCR + "Press OK to continue with prompted (not 'silent') file " + _
      "conversion." + vbCR + "You will be prompted to overwrite any " + _
      "output files that already exist.", vbOK, titleTxt)
      If response = vbCancel Then
        wScript.Quit
      End If
End Sub

Sub CancelQuit
  MsgBox "Macro cancelled. Your file was not converted.", _
        vbOKOnly, titleTxt
    wScript.Quit
End Sub

Sub IgnoreSubdirs
  response = MsgBox("The " + Chr(34) + "subdirs" + Chr(34) + " parameter is ignored " + _
       "when converting multiple" + vbCR + "files from one directory to another." + _
      vbCR + vbCR + "Press OK to continue with conversion from one directory only.",_
      vbOK, titleTxt)
    If response = vbCancel Then
        wScript.Quit
    End If
End Sub

Function InArray(item,A)
     Dim i
     For i=0 To UBound(A) Step 1
         If A(i) = item Then
             InArray=True
             Exit Function
         End If
     Next
     InArray=False
End Function

Function FileMatchesPattern(strFileName, strWildCard)
  ' by Bigjokey at www.experts-exchange.com
  ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  ' Function to test if a filename matches the wildcard characters passed.
    ' Params:
  '  strFileName    String, Holding the name of the file to test (must not include the path)
  '  strWildCard    String, Holding the wildcard string used to compare the file with. (eg. "*.vbs")
  ' Returns: 
  '   True if the filename matches the wildcard, otherwise False.
  ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
     Dim objRegExp, strPattern
    Set objRegExp = CreateObject("VBScript.RegExp")
    ' Update the wildcard string to define a valid regular expression
    strPattern = Replace(strWildCard, ".", "\.")
    strPattern = Replace(strPattern, "*", ".*")
    '''''' next added by EM
    strPattern = Replace(strPattern, "?", ".")
    ''''''
    strPattern = "^" & strPattern & "$"
      With objRegExp
      .Pattern = strPattern
      .IgnoreCase = True
      .Global = True
    End With
      FileMatchesPattern = objRegExp.Test(strFileName)
    Set objRegExp = Nothing
End Function
 
Sub OpenAndSave(oFile, sOutDir)
  Set oWord = CreateObject("Word.Application")
  oWord.Visible = False
  'save autoopen etc settings, and turn off for this file
  Dim secAutomation
     secAutomation = oWord.AutomationSecurity
    oWord.AutomationSecurity = 3
        
On Error Resume Next
  Set oDoc = oWord.Documents.Open(oFile.path, , True)
  If Err.Number <> 0 Then
    MsgBox "Word encountered an error when attempting to open " + oFile.path + "." + _
        vbCR + vbCR + "This error was NOT caused by this script." + vbCR + vbCR + _
        "The error was caused ONLY by Microsoft Word." + _
        "You may want to try opening the file separately in Word." +vbCR + vbCR +_
        "This script will stop. Some files may not have been converted.", _
        vbOKOnly, titleTxt
      oWord.Quit 0
      If silent = 0 Then
        oExplorer.Quit
      End If
      Wscript.Quit
   End If
On Error GoTo 0
  Set oDoc = oWord.ActiveDocument
      fVer = oWord.WordBasic.FileVersion
      If InStr(UCase(fVer), UCase("WordPerfect")) Then
         If InStr(fVer, "6.x") Then
           wpVer = 6
         Else
           wpVer = 5
         End If
       '' Overwrite prompting
       If replaceOK = 0 Then
         If oFSO.FileExists(sOutDir + "\" + oFile.name + sDefaultExt) Then
           Dim oTarget
           Set oTarget = oFSO.getFile(sOutDir + "\" + oFile.name + sDefaultExt)
             msgTxt = "Output file " + oTarget + " already exists!" + vbCR _
                + vbCR + "Overwrite existing file? Press Yes to overwrite." + _
                vbCR + vbCR + "Press No to skip this file, or Cancel to exit this script."
            styleBtn = VBYesNoCancel or VBDefaultButton2 or VBExclamation
            response = MsgBox(msgTxt, styleBtn, titleTxt)
            Select Case response
            Case VBCancel 
              oWord.Quit 0
              StopIE
              wScript.Quit
            Case VBNo
                oWord.AutomationSecurity = secAutomation
                'oDoc = Nothing
              oWord.Quit 0
              Exit Sub
            Case VBYes
           End Select
         End If
       End If
       
       '' Delete existing ouput file when replacing font
       If FontMethod <> "" Then
         If oFSO.FileExists(sOutDir + "\" + oFile.name + sDefaultExt) Then
            Dim oDelFile
            Set oDelFile = oFSO.getFile(sOutDir + "\" + oFile.name + sDefaultExt)
            oDelFile.Delete True
        End If
       FontReplace oDoc 
      End If
      
      '' Delete existing ouput file when adjusting format
      If fixFormat = 1 Then
          If oFSO.FileExists(sOutDir + "\" + oFile.name + sDefaultExt) Then
            Dim oDelFileBis
            Set oDelFileBis = oFSO.getFile(sOutDir + "\" + oFile.name + sDefaultExt)
            oDelFileBis.Delete True
        End If
         AdjustFormat(oDoc)
       End If
               
       oDoc.SaveAs sOutDir + "\" + oFile.name + sDefaultExt
      'If useIE = 1 Then
      '  oExplorer.Document.Body.InnerHTML = "<p style='font: 9pt sans-serif'>Converting " & _
      '    oFile.path & "<br>" & fileCount + 1 & " file(s) converted so far.</p>"
      '  WSHShell.AppActivate(titleTxt)
      'End If
      fileCount = fileCount + 1
    Else
      notCount = notCount + 1
    End If
  Set oDoc = Nothing
  'Set oFSO = Nothing
  'restore autoopen etc setting
   oWord.AutomationSecurity = secAutomation
  
  oWord.Quit 0
End Sub

Sub OpenAndExportPDF(oFile, sOutDir)
  Set oWord = CreateObject("Word.Application")
  oWord.Visible = False
  'save autoopen etc settings, and turn off for this file
  Dim secAutomation
  secAutomation = oWord.AutomationSecurity
  oWord.AutomationSecurity = 3
      
On Error Resume Next
  Set oDoc = oWord.Documents.Open(oFile.path, , True)
  If Err.Number <> 0 Then
    MsgBox "Word encountered an error when attempting to open " + oFile.path + "." + _
        vbCR + vbCR + "This error was NOT caused by this script." + vbCR + vbCR + _
        "The error was caused ONLY by Microsoft Word." + _
        "You may want to try opening the file separately in Word." +vbCR + vbCR +_
        "This script will stop. Some files may not have been converted.", _
        vbOKOnly, titleTxt
        oWord.Quit 0
      If silent = 0 Then
          oExplorer.Quit
      End If
      Wscript.Quit
   End If
On Error GoTo 0
  Set oDoc = oWord.ActiveDocument
      fVer = oWord.WordBasic.FileVersion
      If InStr(UCase(fVer), UCase("WordPerfect")) Then
         If InStr(fVer, "6.x") Then
           wpVer = 6
         Else
           wpVer = 5
         End If
       '' Overwrite prompting
       If replaceOK = 0 Then
         If oFSO.FileExists(sOutDir + "\" + oFile.name + sDefaultExt) Then
           Dim oTarget
           Set oTarget = oFSO.getFile(sOutDir + "\" + oFile.name + sDefaultExt)
             msgTxt = "Output file " + oTarget + " already exists!" + vbCR _
                + vbCR + "Overwrite existing file? Press Yes to overwrite." + vbCR + _
                vbCR + "Press No to skip this file, or Cancel to exit this script."
            styleBtn = VBYesNoCancel or VBDefaultButton2 or VBExclamation
            response = MsgBox(msgTxt, styleBtn, titleTxt)
            Select Case response
            Case VBCancel 
              oWord.Quit 0
              StopIE
              wScript.Quit
            Case VBNo
              oWord.AutomationSecurity = secAutomation
              'oDoc = Nothing
              oWord.Quit 0
              Exit Sub
            Case VBYes
           End Select
         End If
       End If
       
       '' Delete existing ouput file when replacing font
       If FontMethod <> "" Then
         If oFSO.FileExists(sOutDir + "\" + oFile.name + sDefaultExt) Then
            Dim oDelFile
            Set oDelFile = oFSO.getFile(sOutDir + "\" + oFile.name + sDefaultExt)
            oDelFile.Delete True
        End If
       FontReplace oDoc 
      End If
      
      '' Delete existing ouput file when adjusting format
      If fixFormat = 1 Then
          If oFSO.FileExists(sOutDir + "\" + oFile.name + sDefaultExt) Then
            Dim oDelFileBis
            Set oDelFileBis = oFSO.getFile(sOutDir + "\" + oFile.name + sDefaultExt)
            oDelFileBis.Delete True
        End If
         AdjustFormat(oDoc)
       End If
       
      oDoc.ExportAsFixedFormat sOutDir + "\" + oFile.name + sDefaultExt , 17, PDFOpen
        
      fileCount = fileCount + 1
    Else
      notCount = notCount + 1
    End If
  Set oDoc = Nothing
  'Set oFSO = Nothing
  'restore autoopen etc setting
   oWord.AutomationSecurity = secAutomation
  
  oWord.Quit 0
End Sub

Sub FontReplace(oDoc)
   If FontMethod = "WholeFile" Then
    If AllDocFont <> "" Then 
       'Fix the skipped blank Header/Footer problem as provided by Peter Hewett
      lngJunk = oDoc.Sections(1).Headers(1).Range.StoryType
      'Iterate through all story types in the current document
      For Each rngStory In oDoc.StoryRanges
        'Iterate through all linked stories
        Do
          With rngStory.Font
            .Name = AllDocFont
            If NewFontSize > 0 Then
              .Size = NewFontSize
            End If
          End With
          'Get next linked story (if any)
          Set rngStory = rngStory.NextStoryRange
        Loop Until rngStory Is Nothing
      Next
     End If
  End If
   
  If FontMethod = "MultiFont" Then
      Dim FontDict
      Set FontDict = CreateObject("Scripting.Dictionary")
      If BadFirstFont <> "" Then 
            FontDict.add BadFirstFont, NewFirstFont
        If BadSecondFont <> "" Then  
            FontDict.add BadSecondFont, NewSecondFont
          If BadThirdFont <> "" Then
            FontDict.add BadThirdFont, NewThirdFont
          End If
        End If
      End If
      Dim BadFont, NewFont
      Dim items : items = FontDict.Items
      Dim keys : keys = FontDict.Keys
      Dim i
      For i = 0 To FontDict.Count - 1
          BadFont = keys(i)
          NewFont = items(i)
       
          'Fix the skipped blank Header/Footer problem as provided by Peter Hewett
          lngJunk = oDoc.Sections(1).Headers(1).Range.StoryType
          'Iterate through all story types in the current document
          For Each rngStory In oDoc.StoryRanges
            'Iterate through all linked stories
            Do
              With rngStory.Find
                'Run font replacement twice, first for bidirectional, then normal fonts
                .Font.NameBi = BadFont
                .Replacement.Font.Name = NewFont
                .Execute ,,,,,,,1,,,2  ' same as Wrap and Replace 
                .Font.Name = BadFont
                .Replacement.Font.Name = NewFont
                .Execute ,,,,,,,1,,,2  ' same as Wrap and Replace 
              End With
              'Get next linked story (if any)
              Set rngStory = rngStory.NextStoryRange
            Loop Until rngStory Is Nothing
          Next 
      Next
  End If  
End Sub 

Function FontInstalled(sFont) 
     If sFont <> "" Then
       Const HKLM = &H80000002 
       Dim fontName : fontName = sFont
       Dim objReg : Set objReg = GetObject("winmgmts:\\.\root\default:StdRegProv") 
       Dim strKeyPath : strKeyPath = "Software\Microsoft\Windows NT\CurrentVersion\Fonts" 
        Dim arrNames 
       objReg.EnumValues HKLM, strKeyPath, arrNames 
       If IsArray(arrNames) Then 
           If InStr(UCase(Join(arrNames, "|")), UCase(fontName + " (TrueType)")) Then 
               'WScript.Echo fontName & " is installed"
               FontInstalled = 1 
           ElseIf InStr(UCase(Join(arrNames, "|")), UCase(fontName + " Regular (TrueType)")) Then 
               FontInstalled = 1 
           Else
                FontInstalled = 0
                MsgBox "Error: The specified replacement font" + vbCR + vbCR + _
                "   " + fontName + vbCR + vbCR + _
                "seems not to be installed in this system." + vbCR + _
                "Please edit this script to correct the error.", vbOKOnly, titleTxt
                WScript.Quit
           End If 
       End If 
     End If
 End Function

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''Internet Explorer message box

Sub RunIE
  If useIE = 1 Then
    'Dim oExplorer
    'Set oExplorer = WScript.CreateObject("InternetExplorer.Application")
    oExplorer.Navigate "about:blank"   
    oExplorer.ToolBar = 0
    oExplorer.StatusBar = 0
    oExplorer.Width=250
    oExplorer.Height = 100 
    oExplorer.Left = 30
    oExplorer.Top = 30
    Do While (oExplorer.Busy)
        Wscript.Sleep 200
    Loop    
    oExplorer.Visible = 1
    oExplorer.Document.Title = titleTxt
    oExplorer.Document.Body.InnerHTML = "<p style='font: 9pt sans-serif'>" & _
        "Preparing to convert WordPerfect files. <br>" _
        & "This may take several minutes to complete.</p>"
    WSHShell.AppActivate(titleTxt)
  End If
End Sub

Sub WaitIE
  oExplorer.Document.Body.InnerHTML = "<p style='font: 9pt sans-serif'>Checking " & _
        "for WordPerfect files." & "<br>" & fileCount & " file(s) converted so far.</p>"
      WSHShell.AppActivate(titleTxt)
End Sub

Sub StopIE
  If useIE = 1 Then 
    'oExplorer.Document.Body.InnerHTML = "All files converted."
    'Wscript.Sleep 2000
    oExplorer.Quit
  End If
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''' Adjust formatting in Word

Sub AdjustFormat(oDoc)
  If wpVer = 6 Then
    With oDoc
'    .Compatibility(1)  = True  ' wdNoTabHangIndent - Do not add automatic tab stop for hanging indent
'    .Compatibility(2)  = False ' wdNoSpaceRaiseLower - No extra space for raised/lowered characters
'    .Compatibility(3)  = False ' wdPrintColBlack - Print colors as black on noncolor printers.
'    .Compatibility(4)  = True  ' wdWrapTrailSpaces - Wrap trailing spaces to the next line
'    .Compatibility(5)  = False ' wdNoColumnBalance - Do not balance columns for continuous section starts
'    .Compatibility(6)  = False ' wdConvMailMergeEsc - Treat \" as "" in mailmerge data sources
'    .Compatibility(7)  = False ' wdSuppressSpBfAfterPgBrk - No Space Before after hard pg or col break
'    .Compatibility(8)  = False ' wdSuppressTopSpacing - Suppress extra line spacing at the top of a page
'    .Compatibility(9)  = False ' wdOrigWordTableRules - Combine table borders like Word 5.x for the Mac
'    .Compatibility(10) = False ' wdTransparentMetafiles - Do not blank the area behind metafile pictures
'    .Compatibility(11) = False ' wdShowBreaksInFrames - Show hard pg or col breaks in frames
'    .Compatibility(12) = False ' wdSwapBordersFacingPages) - Swap left/right borders on odd facing pages
'    .Compatibility(13) = False ' wdLeaveBackslashAlone - Convert backslash characters into Yen signs
'    .Compatibility(14) = False ' wdExpandShiftReturn - No expand char spaces on lns ending in LineBreak
'    .Compatibility(15) = False ' wdDontULTrailSpace - Draw underline on trailing spaces
'    .Compatibility(16) = False ' wdDontBalanceSingleByteDoubleByteWidth - alance SBCS chars and DBCS chars
'    .Compatibility(17) = False ' wdSuppressTopSpacingMac5) - No extra ln space at pg top like MacWord 5
'    .Compatibility(18) = False ' wdSpacingInWholePoints - Expand/condense by whole number of points
'    .Compatibility(19) = False ' wdPrintBodyTextBeforeHeader - Print body text before header/footer
'    .Compatibility(20) = False ' wdNoLeading - Do not adding leading between rows of text
'    .Compatibility(21) = False ' wdNoSpaceForUL - Add space for underline
'    .Compatibility(22) = False ' wdMWSmallCaps - use larger small caps like Word 5 for the Mac
    .Compatibility(23) = True ' wdNoExtraLineSpacing - Suppress extra line spacing the way WP5.x does
'    .Compatibility(24) = False ' wdTruncateFontHeight - Truncate font height
'    .Compatibility(25) = True  ' wdSubFontBySize - Substitute fonts based on size
'    .Compatibility(26) = False ' wdUsePrinterMetrics - Use printer metrics to lay out document
'    .Compatibility(27) = False ' wdWW6BorderRules - Use Word 6.x/95 border rules
'    .Compatibility(28) = False ' wdExactOnTop - Do not center "exact line height" lines
'    .Compatibility(29) = True  ' wdSuppressBottomSpacing - Suppress extra line spacing at foot of page
'    .Compatibility(30) = False ' wdWPSpaceWidth - Set width of a space like WordPerfect 5.x
'    .Compatibility(31) = False ' wdWPJustification - Do full justification like WPWin 6.x
'    .Compatibility(32) = True  ' wdLineWrapLikeWord6 - Line wrap like Word 6.0
'    .Compatibility(33) = True  ' wdShapeLayoutLikeWW8 - Layout autoshapes like Word 97
'    .Compatibility(34) = True  ' wdFootnoteLayoutLikeWW8 - Layout footnotes like Word 6/95/97
'    .Compatibility(35) = True  ' wdDontUseHTMLParagraphAutoSpacing - Don't use HTML auto para spacing
'    .Compatibility(36) = False ' wdDontAdjustLineHeightInTable - Adjust ln ht to grid ht in table
'    .Compatibility(37) = True  ' wdForgetLastTabAlignment) - Forget last tab alignment
'    .Compatibility(38) = False ' wdAutospaceLikeWW7 - Autospace like Word 95
'    .Compatibility(39) = True  ' wdAlignTablesRowByRow - Align table rows independently
'    .Compatibility(40) = True  ' wdLayoutRawTableWidth - Layout tables with raw width
'    .Compatibility(41) = True  ' wdLayoutTableRowsApart - Allow table rows to be laid out apart
'    .Compatibility(42) = True  ' wdUseWord97LineBreakingRules - Use Word97 rules for breaking Asian text
'    .Compatibility(43) = True  ' wdDontBreakWrappedTables - Don't break wrapped tables across pages
'    .Compatibility(44) = True  ' wdDontSnapTextToGridInTableWithObjects - Do not snap text to grid
'                               '   inside table with inline objects
'    .Compatibility(45) = True  ' wdSelectFieldWithFirstOrLastCharacter - Select entire field with 
'                               '   first or last character
'    .Compatibility(46) = False ' wdApplyBreakingRules - Use line-breaking rules
'    .Compatibility(47) = False ' wdDontWrapTextWithPunctuation - No hanging punct with character grid
'    .Compatibility(48) = True  ' wdDontUseAsianBreakRulesInGrid - No Asian break rules in char. grid
'    .Compatibility(49) = True  ' wdUseWord2002TableStyleRules - Use Word 2002 table style rules
'    .Compatibility(50) = True  ' wdGrowAutofit - Allow tables to expand into margin
'    .Compatibility(51) = True  ' wdUseNormalStyleForList - Use normal style, not ListPara style for
'                               '   numbered and bulleted lists
'    .Compatibility(52) = True  ' wdDontUseIndentAsNumberingTabStop - Don't use hanging indent as tab
'                               '   stop for bullets and numbering
'    .Compatibility(53) = True  ' wdFELineBreak11 - Use Asian rules for hanging punct in Asian texts 
'    .Compatibility(54) = True  ' wdAllowSpaceOfSameStyleInTable - Allow space btw paras in table
'    .Compatibility(55) = True  ' wdWW11IndentRules - Word 2003 rules for indents by wrapped objects
'    .Compatibility(56) = True  ' wdDontAutofitConstrainedTables - Don't autofit tables by wrapped objs
'    .Compatibility(57) = True  ' wdAutofitLikeWW11 - Use Word 2003 autofit table rules 
'    .Compatibility(58) = 1     ' wdUnderlineTabInNumList - Underline tab betw num and text in lists
    End With

  ElseIf wpVer = 5 Then
    With oDoc
'     .Compatibility(1)  = True  ' wdNoTabHangIndent - Do not add automatic tab stop for hanging indent
'     .Compatibility(2)  = False ' wdNoSpaceRaiseLower - No extra space for raised/lowered characters
'     .Compatibility(3)  = False ' wdPrintColBlack - Print colors as black on noncolor printers.
'     .Compatibility(4)  = True  ' wdWrapTrailSpaces - Wrap trailing spaces to the next line
'     .Compatibility(5)  = False ' wdNoColumnBalance - Do not balance columns for continuous section starts
'     .Compatibility(6)  = True  ' wdConvMailMergeEsc - Treat \" as "" in mailmerge data sources
'     .Compatibility(7)  = False ' wdSuppressSpBfAfterPgBrk - No Space Before after hard pg or col break
'     .Compatibility(8)  = False ' wdSuppressTopSpacing - Suppress extra line spacing at the top of a page
'     .Compatibility(9)  = False ' wdOrigWordTableRules - Combine table borders like Word 5.x for the Mac
'     .Compatibility(10) = False ' wdTransparentMetafiles - Do not blank the area behind metafile pictures
'     .Compatibility(11) = False ' wdShowBreaksInFrames - Show hard pg or col breaks in frames
'     .Compatibility(12) = False ' wdSwapBordersFacingPages) - Swap left/right borders on odd facing pages
'     .Compatibility(13) = False ' wdLeaveBackslashAlone - Convert backslash characters into Yen signs
'     .Compatibility(14) = False ' wdExpandShiftReturn - No expand char spaces on lns ending in LineBreak
'     .Compatibility(15) = False ' wdDontULTrailSpace - Draw underline on trailing spaces
'     .Compatibility(16) = False ' wdDontBalanceSingleByteDoubleByteWidth - balance SBCS & DBCS chars
'     .Compatibility(17) = False ' wdSuppressTopSpacingMac5) - Suppress extra ln space at pg top like 
'                                '   Word for the Mac 5.x
'     .Compatibility(18) = False ' wdSpacingInWholePoints - Expand/condense by whole number of points
'     .Compatibility(19) = False ' wdPrintBodyTextBeforeHeader - Print body text before header/footer
'     .Compatibility(20) = False ' wdNoLeading - Do not adding leading between rows of text
'     .Compatibility(21) = False ' wdNoSpaceForUL - Add space for underline
'     .Compatibility(22) = Flase ' wdMWSmallCaps - use larger small caps like Word 5 for Mac
     .Compatibility(23) = True ' wdNoExtraLineSpacing - Suppress extra line spacing like WP5.x
'     .Compatibility(24) = False ' wdTruncateFontHeight - Truncate font height
'     .Compatibility(25) = False ' wdSubFontBySize - Substitute fonts based on size
'     .Compatibility(26) = False ' wdUsePrinterMetrics - Use printer metrics to lay out document
'     .Compatibility(27) = False ' wdWW6BorderRules - Use Word 6.x/95 border rules
'     .Compatibility(28) = False ' wdExactOnTop - Do not center "exact line height" lines
'     .Compatibility(29) = False ' wdSuppressBottomSpacing - Suppress extra line spacing 
'     .Compatibility(30) = False ' wdWPSpaceWidth - Set width of a space like WordPerfect 5.x
'     .Compatibility(31) = False ' wdWPJustification - Do full justification like WPWin 6.x
'     .Compatibility(32) = True  ' wdLineWrapLikeWord6 - Line wrap like Word 6.0
'     .Compatibility(33) = True  ' wdShapeLayoutLikeWW8 - Layout autoshapes like Word 97
'     .Compatibility(34) = True  ' wdFootnoteLayoutLikeWW8 - Layout footnotes like Word 6/95/97
'     .Compatibility(35) = True  ' wdDontUseHTMLParagraphAutoSpacing - Don't use HTML auto para spacing
'     .Compatibility(36) = False ' wdDontAdjustLineHeightInTable - Adjust line ht to grid ht in table
'     .Compatibility(37) = True  ' wdForgetLastTabAlignment) - Forget last tab alignment
'     .Compatibility(38) = False ' wdAutospaceLikeWW7 - Autospace like Word 95
'     .Compatibility(39) = True  ' wdAlignTablesRowByRow - Align table rows independently
'     .Compatibility(40) = True  ' wdLayoutRawTableWidth - Layout tables with raw width
'     .Compatibility(41) = True  ' wdLayoutTableRowsApart - Allow table rows to be laid out apart
'     .Compatibility(42) = True  ' wdUseWord97LineBreakingRules - Use Word97 rules for breaking Asian text
'     .Compatibility(43) = True  ' wdDontBreakWrappedTables - Don't break wrapped tables across pages
'     .Compatibility(44) = True  ' wdDontSnapTextToGridInTableWithObjects - Do not snap text to grid
'                                '   inside table with inline objects
'     .Compatibility(45) = True  ' wdSelectFieldWithFirstOrLastCharacter - Select entire field with 
'                                '   first or last character
'     .Compatibility(46) = False ' wdApplyBreakingRules - Use line-breaking rules
'     .Compatibility(47) = False ' wdDontWrapTextWithPunctuation - No hanging punct with character grid
'     .Compatibility(48) = True  ' wdDontUseAsianBreakRulesInGrid - No Asian break rules in char. grid
'     .Compatibility(49) = True  ' wdUseWord2002TableStyleRules - Use Word 2002 table style rules
'     .Compatibility(50) = True  ' wdGrowAutofit - Allow tables to expand into margin
'     .Compatibility(51) = True  ' wdUseNormalStyleForList - Use normal style, not ListPara style for
'                                '   numbered and bulleted lists
'     .Compatibility(52) = True  ' wdDontUseIndentAsNumberingTabStop - Don't use hanging indent as tab
'                                '   stop for bullets and numbering
'     .Compatibility(53) = True  ' wdFELineBreak11 - Use Asian rules for hanging punct in Asian texts 
'     .Compatibility(54) = True  ' wdAllowSpaceOfSameStyleInTable - Allow space btw paras in table
'     .Compatibility(55) = True  ' wdWW11IndentRules - Word 2003 rules for indents by wrapped objects
'     .Compatibility(56) = True  ' wdDontAutofitConstrainedTables - Don't autofit tables by wrapped objs
'     .Compatibility(57) = True  ' wdAutofitLikeWW11 - Use Word 2003 autofit table rules 
'     .Compatibility(58) = 1     ' wdUnderlineTabInNumList - Underline tab betw num and text in lists
    End With
  End If
End Sub