Option Explicit
Dim PDFExport : PDFExport = "No"
Dim TakesTimePrompt : TakesTimePrompt = "Off"
Dim PromptForOverwrite : PromptForOverwrite = "On"
Dim ViewFile : ViewFile = "Ask"
Dim Silent : Silent = "No"
Dim sInFile, sOutFile, sFilename
Dim sApp, sFSpec, sInPath, sOutPath, sOutURL, winAddr, WshShell, defaultExt
Dim args, num, msgTxt, styleBtn, response, userIn, msgEnd
Dim nameString : nameString = "LibreOffice"
Dim titleTxt : titleTxt = "Export WP file using " & nameString
Dim strReg, strAppPath, strTmpDir, strFull, strFolder, strName
Dim strFileTemp, strOutTemp, cvtTo, doDelete, doView, oTmp
Dim objShell : Set objShell = CreateObject("Wscript.Shell")
Dim oFSO : Set oFSO = CreateObject("Scripting.FileSystemObject")
Dim CurDir : CurDir = oFSO.GetParentFolderName(Wscript.ScriptFullName)
Dim strScript : strScript = LCase(Wscript.ScriptName)
GetAppPath
UserOptions
GetFileNames
CopyConvert
OpenForEditing
WScript.Quit
Sub GetAppPath
On Error Resume Next
strReg = objShell.RegRead("HKCR\Software\LibreOffice\LibreOffice\Path")
If Err.Number <> 0 Then
MsgBox "Unable to find LibreOffice on this system. Quitting.", _
vbOKOnly + VbMsgBoxSetForeground, titleTxt
wScript.Quit
End If
strAppPath = strReg & "program\soffice.exe"
If oFSO(FileExists(strAppPath)) Then
Else
MsgBox "LibreOffice application missing or not properly installed. Quitting.", _
vbOKOnly + VbMsgBoxSetForeground, titleTxt
wScript.Quit
End If
objShell.CurrentDirectory = strReg & "URE\bin"
strTmpDir = objShell.ExpandEnvironmentStrings("%temp%")
End Sub
Sub UserOptions
Select Case LCase(PDFExport)
Case "yes"
DoPDF
Case "no"
DoDoc
Case Else
MsgBox "Error: The PDFExport variable must be either 'Yes' or 'No'." + vbCR + _
vbCR + "You entered: '" + pdfExport + "'.", vbOKOnly + VbMsgBoxSetForeground,_
titleTxt
WScript.Quit
End Select
titleTxt = "Export WP file to " + sApp + " using " + nameString
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 + VbMsgBoxSetForeground, titleTxt
WScript.Quit
End If
If LCase(PromptForOverwrite) = "off" Then
ElseIf LCase(PromptForOverwrite) = "on" Then
Else
MsgBox "Error: The PromptForOverwrite variable must be either 'On' or 'Off'." _
+ vbCR + vbCR + "You entered: '" + PromptForOverwrite + "'.", _
vbOKOnly + VbMsgBoxSetForeground, titleTxt
WScript.Quit
End If
Select Case LCase(ViewFile)
Case "yes"
doView = "yes"
Case "no"
doView = "no"
Case "ask"
doView = "yes"
Case Else
MsgBox "Error: The PDFExport variable must be either 'Yes' or 'No'." + vbCR + _
vbCR + "You entered: '" + pdfExport + "'.", vbOKOnly, _
"Export WP file using LibreOffice"
WScript.Quit
End Select
If LCase(Silent) = "no" Then
ElseIf LCase(Silent) = "yes" Then
Else
MsgBox "Error: The Silent variable must be either 'Yes' or 'No'." + vbCR + vbCR + _
"You entered: '" + Silent + "'.", vbOKOnly + VbMsgBoxSetForeground, titleTxt
WScript.Quit
End If
If inStr(strScript, "pdf") <> 0 Then
DoPDF
If inStr(strScript, "doc") <> 0 Then
DoubleName
End If
End If
If inStr(strScript, "doc") <> 0 Then
DoDoc
End If
If inStr(strScript, "view") <> 0 Then
doView = "yes"
ViewFile = "yes"
End If
End Sub Sub GetFileNames
Set args = WScript.Arguments
num = args.Count
If num = 0 Then
MsgBox "Error: Drop a WP file on this script icon, or use a filename as a command-line parameter.", _
vbOKOnly + VbMsgBoxSetForeground, titleTxt
wScript.Quit
End If
sInFile = args.Item(0)
titleTxt = "Export WP file to " + sApp + " with " + nameString
If InStr(sInFile, "\") = 0 Then
sInFile = CurDir + "\" + sInFile
End If
If oFSO.FileExists(sInFile) Then
Else
MsgBox "Error: The specified input file does not exist.", vbOKOnly, titleTxt
WScript.Quit
End If
Dim objInFile
Set objInFile = oFSO.GetFile(sInFile)
sInPath = objInFile.ParentFolder
If num >= 2 Then
sOutFile = args.Item(1)
If LCase(sOutFile) = "pdf" Then
sOutFile = sInfile + ".pdf"
DoPDF
ElseIf LCase(sOutFile) = "doc" Then
sOutFile = sInfile + ".doc"
DoDoc
ElseIf LCase(Right(sOutFile,4)) = ".doc" Then
DoDoc
ElseIf LCase(Right(sOutFile,4)) = ".pdf" Then
DoPDF
Else
MsgBox "Output file parameter must be a valid filename with the extension .DOC or .PDF," + vbCR + _
"or the three-letter parameter DOC or PDF.", vbOKOnly + vbMsgBoxSetForeground, _
titleTxt
WScript.Quit
End If
If InStr(sOutFile, "\") = 0 Then
sOutFile = sInPath + "\" + sOutFile
sOutFile = Replace(sOutFile, "\\", "\")
End If
titleTxt = "Export WP file to " + sApp + " with " + nameString
Else
sOutFile = sInFile + defaultExt
End If
If oFSO.FolderExists(sOutFile) Then
MsgBox "Error: The specified output file '" + sOutFile + "' is the name of a folder." _
+ vbCR + vbCr + "Please specify a valid filename instead.", _
vbOKOnly + VbMsgBoxSetForeground, titleTxt
WScript.Quit
End If
If LCase(Silent) = "no" Then
msgTxt = nameString + " will export WP file " + UCase(sInFile) + " to " + sApp + " file:" + _
vbCR + vbCR + sOutFile + vbCR + vbCR + "Use different filename for converted file?"
styleBtn = VBYesNoCancel + VBDefaultButton2 + VBInformation + VbMsgBoxSetForeground
response = MsgBox(msgTxt, StyleBtn, titleTxt)
If response = VBYes Then
GetsOutFile(sFilename)
Else
If response = VBCancel Then
CancelQuit
End If
End If
End If
While LCase(Right(sOutFile,4)) <> defaultExt
MsgBox "You may not change the extension of the output file from " + defaultExt, _
vbOKOnly, titleTxt
Dim iStrLen : iStrLen = Len(sOutFile)
sOutFile = Left(sOutFile,(iStrLen -4)) + defaultExt
GetsOutFile(sOutFile)
Wend
While UCase(sInFile) = UCase(sOutFile)
msgTxt = "Source file and converted file must have different names."
styleBtn = VBOK + 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
Wend
If LCase(Silent) = "no" Then
If LCase(PromptForOverwrite) = "on" Then
If oFSO.FileExists(sOutFile) Then
msgTxt = "Output file " + sOutFile + " exists!" + vbCR + vbCR + _
"Overwrite existing file?"
styleBtn = VBYesNo + VBDefaultButton2 + VBExclamation + _
VbMsgBoxSetForeground + vbSystemModal
Wscript.Sleep 100
response = MsgBox(msgTxt, styleBtn, titleTxt)
If response = VBNo Then
doDelete = "no"
GetsOutFile(sOutFile)
Else
doDelete = "yes"
End If
End If
End If
Else
If oFSO.FileExists(sOutFile) Then
oFSO.DeleteFile(sOutFile)
End If
End If
strFull = oFSO.GetAbsolutePathName(sInFile)
strFolder = oFSO.GetParentFolderName(sInFile)
strName = oFSO.GetFileName(sInFile)
strFileTemp = strTmpDir & "\" & strName & ".wpd"
strOutTemp = strTmpDir & "\" & strName & defaultExt
End Sub Sub CopyConvert
If LCase(Silent) = "no" Then
If LCase(TakesTimePrompt) = "on" Then
response = MsgBox("File conversion may take time. Press OK, and please wait.", _
vbOK + VbMsgBoxSetForeground, titleTxt)
If response = vbCancel Then
wScript.Quit
End If
End If
End If
Const OverwriteExisting = True
oFSO.CopyFile sInFile, strFileTemp, OverwriteExisting
Const ReadOnly = 1
Set oTmp = oFSO.GetFile(strFileTemp)
If oTmp.Attributes AND ReadOnly Then
oTmp.Attributes = oTmp.Attributes XOR ReadOnly
End If
objShell.Run Chr(34) & strAppPath & Chr(34) & _
" --invisible --convert-to " & cvtTo & " --outdir " & strTmpDir & " " & strFileTemp, 0, True
If doDelete = "yes" Then
If oFSO.FileExists(sOutFile) Then
oFSO.DeleteFile(sOutFile)
End If
End If
Wscript.Sleep 100
oFSO.MoveFile strOutTemp, sOutFile
oFSO.DeleteFile strFileTemp
If LCase(Silent) = "no" Then
If doView = "no" Then
MsgBox sOutFile & " written to disk.", vbOKOnly, titleTxt
End If
End If
End Sub Sub OpenForEditing
If doView = "yes" then
If LCase(ViewFile) = "yes" Then
objShell.Run Chr(34) & sOutFile & Chr(34), 1, false
Else
If LCase(Silent) = "no" Then
If PDFExport = 0 Then
msgEnd = "for editing?"
ElseIf PDFExport = 1 Then
msgEnd = "for viewing?"
End If
msgTxt = "Exported file saved as " + sOutFile + vbCR + vbCR + _
"Open exported file " + msgEnd
styleBtn = VBYesNo + VBDefaultButton2 + VBInformation + VbMsgBoxSetForeground
response = MsgBox(msgTxt, styleBtn, titleTxt)
If response = VBYes Then
objShell.Run Chr(34) & sOutFile & Chr(34), 1, false
End If
Else
objShell.Run Chr(34) & sOutFile & Chr(34), 1, false
End If
End If
End If
End Sub Sub DoDoc
PDFExport = 0
defaultExt = ".doc"
cvtTo = "doc"
sApp = "Word"
End Sub Sub DoPDF
PDFExport = 1
defaultExt = ".pdf"
cvtTo = "pdf"
sApp = "PDF"
End Sub Function CancelQuit
MsgBox "Macro cancelled. Your file was not converted.", _
vbOKOnly + VbMsgBoxSetForeground, titleTxt
wScript.Quit
End Function Function GetsOutFile(sFilename)
userIn = InputBox("Enter path and filename for converted file: ", _
titleTxt, sOutFile)
sOutFile = userIn
If Len(userIn) = 0 Then
wScript.Quit
End If
End Function Function DoubleName
MsgBox "The name of this script cannot contain both DOC and PDF." _
+ vbCR + vbCR + "Quitting.", vbOKOnly + VbMsgBoxSetForeground, titleTxt
wScript.Quit
End Function