Rob van der Woude's Scripting Pages
Powered by GeSHi

Source code for word2any.vbs

(view source code of word2any.vbs as plain text)

  1. Option Explicit
  2.  
  3. Dim arrFileExt, arrFileTypes
  4. Dim blnOverwrite, blnTest
  5. Dim intConvertedFiles, intFileTypeOut, intMatchingFiles, intOverwriteErrors, intValidArgs
  6. Dim objFileIn, objFSO, objParentFolderIn
  7. Dim strExtensionIn,  strFileNameIn,  strFileSpecIn,  strParentFolderIn
  8. Dim strExtensionOut, strFileNameOut, strFileSpecOut, strParentFolderOut
  9. Dim strFileIn, strFileOut, strFileTypeOut, strKey, strMsg, strResult
  10.  
  11. Const wdFormatDocument                    =  0
  12. Const wdFormatDocument97                  =  0
  13. Const wdFormatDocumentDefault             = 16
  14. Const wdFormatDOSText                     =  4
  15. Const wdFormatDOSTextLineBreaks           =  5
  16. Const wdFormatEncodedText                 =  7
  17. Const wdFormatFilteredHTML                = 10
  18. Const wdFormatFlatXML                     = 19
  19. Const wdFormatFlatXMLMacroEnabled         = 20
  20. Const wdFormatFlatXMLTemplate             = 21
  21. Const wdFormatFlatXMLTemplateMacroEnabled = 22
  22. Const wdFormatHTML                        =  8
  23. Const wdFormatOpenDocumentText            = 23
  24. Const wdFormatPDF                         = 17
  25. Const wdFormatRTF                         =  6
  26. Const wdFormatStrictOpenXMLDocument       = 24
  27. Const wdFormatTemplate                    =  1
  28. Const wdFormatTemplate97                  =  1
  29. Const wdFormatText                        =  2
  30. Const wdFormatTextLineBreaks              =  3
  31. Const wdFormatUnicodeText                 =  7
  32. Const wdFormatWebArchive                  =  9
  33. Const wdFormatXML                         = 11
  34. Const wdFormatXMLDocument                 = 12
  35. Const wdFormatXMLDocumentMacroEnabled     = 13
  36. Const wdFormatXMLTemplate                 = 14
  37. Const wdFormatXMLTemplateMacroEnabled     = 15
  38. Const wdFormatXPS                         = 18
  39.  
  40. blnOverwrite = False
  41.  
  42. Set arrFileExt = CreateObject( "Scripting.Dictionary" )
  43. ' Default file type based on extension only
  44. arrFileExt.Item( "doc" )  =  0
  45. arrFileExt.Item( "docx" ) =  0
  46. arrFileExt.Item( "htm" )  =  8
  47. arrFileExt.Item( "html" ) =  8
  48. arrFileExt.Item( "odt" )  = 23
  49. arrFileExt.Item( "pdf" )  = 17
  50. arrFileExt.Item( "rtf" )  =  6
  51. arrFileExt.Item( "txt" )  =  4
  52. arrFileExt.Item( "xml" )  = 19
  53. arrFileExt.Item( "xps" )  = 18
  54.  
  55. Set arrFileTypes = CreateObject( "Scripting.Dictionary" )
  56. ' All available file types
  57. arrFileTypes.Item( "Document" )                    =  0
  58. arrFileTypes.Item( "Document97" )                  =  0
  59. arrFileTypes.Item( "DocumentDefault" )             = 16
  60. arrFileTypes.Item( "DOSText" )                     =  4
  61. arrFileTypes.Item( "DOSTextLineBreaks" )           =  5
  62. arrFileTypes.Item( "EncodedText" )                 =  7
  63. arrFileTypes.Item( "FilteredHTML" )                = 10
  64. arrFileTypes.Item( "FlatXML" )                     = 19
  65. arrFileTypes.Item( "FlatXMLMacroEnabled" )         = 20
  66. arrFileTypes.Item( "FlatXMLTemplate" )             = 21
  67. arrFileTypes.Item( "FlatXMLTemplateMacroEnabled" ) = 22
  68. arrFileTypes.Item( "HTML" )                        =  8
  69. arrFileTypes.Item( "OpenDocumentText" )            = 23
  70. arrFileTypes.Item( "PDF" )                         = 17
  71. arrFileTypes.Item( "RTF" )                         =  6
  72. arrFileTypes.Item( "StrictOpenXMLDocument" )       = 24
  73. arrFileTypes.Item( "Template" )                    =  1
  74. arrFileTypes.Item( "Template97" )                  =  1
  75. arrFileTypes.Item( "Text" )                        =  2
  76. arrFileTypes.Item( "TextLineBreaks" )              =  3
  77. arrFileTypes.Item( "UnicodeText" )                 =  7
  78. arrFileTypes.Item( "WebArchive" )                  =  9
  79. arrFileTypes.Item( "XML" )                         = 11
  80. arrFileTypes.Item( "XMLDocument" )                 = 12
  81. arrFileTypes.Item( "XMLDocumentMacroEnabled" )     = 13
  82. arrFileTypes.Item( "XMLTemplate" )                 = 14
  83. arrFileTypes.Item( "XMLTemplateMacroEnabled" )     = 15
  84. arrFileTypes.Item( "XPS" )                         = 18
  85.  
  86. ' Command line parsing
  87. intValidArgs = 0
  88. If WScript.Arguments.Named.Exists( "O" ) Then
  89. 	blnOverwrite = True
  90. 	intValidArgs = intValidArgs + 1
  91. End If
  92. If WScript.Arguments.Named.Exists( "T" ) Then
  93. 	strFileTypeOut = WScript.Arguments.Named.Item( "T" )
  94. 	If strFileTypeOut = "" Then
  95. 		strMsg = "Number:" & vbTab & "FileType:" & vbCrLf & "======" & vbTab & "======" & vbCrLf
  96. 		For Each strKey In arrFileTypes.Keys
  97. 			strMsg = strMsg & arrFileTypes.Item( strKey ) & vbTab & strKey & vbCrLf
  98. 		Next
  99. 		strMsg = strMsg & vbCrLf & "More details at:" & vbCrLf & "msdn.microsoft.com/library/office/ff839952"
  100. 		strMsg = strMsg & vbCrLf & vbCrLf & "Example: /T:18 or /T:XPS"
  101. 		If IsInGUI Then
  102. 			MsgBox strMsg, vbOKOnly, "List of Known File Types"
  103. 		Else
  104. 			WScript.Echo "List of Known File Types" & vbCrLf & vbCrLf & strMsg
  105. 		End If
  106. 		WScript.Quit 0
  107. 	Else
  108. 		blnTest = False
  109. 		If arrFileTypes.Exists( strFileTypeOut ) Then
  110. 			strFileTypeOut = arrFileTypes.Item( strFileTypeOut )
  111. 			blnTest        = True
  112. 		ElseIf IsNumeric( strFileTypeOut ) Then
  113. 			For Each strKey In arrFileTypes.Keys
  114. 				If CStr( arrFileTypes.Item( strKey ) ) = CStr( strFileTypeOut ) Then
  115. 					blnTest = True
  116. 				End If
  117. 			Next
  118. 		End If
  119. 		If Not blnTest Then
  120. 			Syntax "Invalid file type." & vbCrLf & vbTab & "Use 'Word2Any.vbs /T' to list available file types."
  121. 		Else
  122. 			intValidArgs = intValidArgs + 1
  123. 		End If
  124. 	End If
  125. End If
  126. If intValidArgs <> WScript.Arguments.Named.Count Then
  127. 	Syntax "Invalid command line switch(es)."
  128. End If
  129.  
  130. Set objFSO = CreateObject( "Scripting.FileSystemObject" )
  131.  
  132. ' More command line parsing
  133. With objFSO
  134. 	If WScript.Arguments.Unnamed.Count = 1 Then
  135. 		strFileSpecIn      = .GetAbsolutePathName( WScript.Arguments.Unnamed(0) )
  136. 		strExtensionIn     = .GetExtensionName( strFilespecIn )
  137. 		strFileNameIn      = .GetBaseName( strFilespecIn )
  138. 		strParentFolderIn  = .GetParentFolderName( strFilespecIn )
  139. 		If strFileTypeOut = "" Then
  140. 			Syntax "Specify an output file name and/or file type." & vbCrLf & vbTab & "Use 'Word2Any.vbs /T' to list all available file types."
  141. 		Else
  142. 			For Each strKey In arrFileExt.Keys
  143. 				If CStr( arrFileExt.Item( strKey ) ) = CStr( strFileTypeOut ) Then
  144. 					strExtensionOut = strKey
  145. 				End If
  146. 			Next
  147. 			strFileNameOut     = strFileNameIn
  148. 			strParentFolderOut = strParentFolderIn
  149. 			strFileSpecOut     = .BuildPath( strParentFolderOut, strFileNameOut & "." & strExtensionOut )
  150. 		End If
  151. 	ElseIf WScript.Arguments.Unnamed.Count = 2 Then
  152. 		strFileSpecIn      = .GetAbsolutePathName( WScript.Arguments.Unnamed(0) )
  153. 		strExtensionIn     = .GetExtensionName( strFilespecIn )
  154. 		strFileNameIn      = .GetBaseName( strFilespecIn )
  155. 		strParentFolderIn  = .GetParentFolderName( strFilespecIn )
  156. 		strFileSpecOut     = WScript.Arguments.Unnamed(1)
  157. 		strExtensionOut    = .GetExtensionName( strFileSpecOut )
  158. 		strFileNameOut     = .GetBaseName( strFileSpecOut )
  159. 		strParentFolderOut = .GetParentFolderName( strFileSpecOut )
  160. 		If strParentFolderOut = "" Then
  161. 			strParentFolderOut = strParentFolderIn
  162. 		Else
  163. 			strParentFolderOut = .GetAbsolutePathName( strParentFolderOut )
  164. 		End If
  165. 		If strFileNameOut = "*" Then
  166. 			strFileNameOut = strFileNameIn
  167. 			strFileSpecOut = .BuildPath( strParentFolderOut, strFileNameOut & "." & strExtensionOut )
  168. 		End If
  169. 		If strFileTypeOut = "" Then
  170. 			If arrFileExt.Exists( strExtensionOut ) Then
  171. 				strFileTypeOut = arrFileExt.Item( strExtensionOut )
  172. 			Else
  173. 				Syntax "Unknown file type for this extension." & vbCrLf & vbTab & "Use '/T:filetype' to specify the file type."
  174. 			End If
  175. 		End If
  176. 	Else
  177. 		Syntax Null
  178. 	End If
  179.  
  180. 	' Command line validation
  181. 	If InStr( strFileSpecIn, "?" ) Or InStr( strFileSpecOut, "?" ) Then
  182. 		Syntax "No ""?"" wildcards allowed in input or output paths."
  183. 	End If
  184. 	If InStr( strExtensionIn, "*" ) Or InStr( strExtensionOut, "*" ) Then
  185. 		Syntax "No wildcards allowed in file extensions."
  186. 	End If
  187. 	If InStr( strParentFolderIn, "*" ) Or InStr( strParentFolderOut, "*" ) Then
  188. 		Syntax "No wildcards allowed in folder paths."
  189. 	End If
  190. 	If ( InStr( strFileNameIn, "*" ) And Not strFileNameIn = "*" ) Or ( InStr( strFileNameOut, "*" ) And Not strFileNameOut = "*" ) Then
  191. 		Syntax "Wildcard ""*"" can only be the entire file name, not a part of it."
  192. 	End If
  193. 	If Not .FolderExists( strParentFolderIn ) Then
  194. 		Syntax "Specified input folder not found."
  195. 	End If
  196. 	If Not .FolderExists( strParentFolderOut ) Then
  197. 		Syntax "Specified output folder not found."
  198. 	End If
  199. 	If strFileNameIn = "*" And Not strFileNameOut = "*" Then
  200. 		Syntax "If the input file name is a ""*"" wildcard, the output file name must be a ""*"" wildcard too."
  201. 	End If
  202.  
  203.  
  204. 	If strFileNameIn = "*" Then
  205. 		intMatchingFiles = 0
  206. 		For Each strFileIn In .GetFolder( strParentFolderIn ).Files
  207. 			If LCase( .GetExtensionName( strFileIn ) ) = LCase( strExtensionIn ) Then
  208. 				intMatchingFiles = intMatchingFiles + 1
  209. 			End If
  210. 		Next
  211. 		If intMatchingFiles = 0 Then
  212. 			Syntax "No files matching Word documents specification."
  213. 		End If
  214. 	Else
  215. 		If Not .FileExists( strFileSpecIn ) Then
  216. 			Syntax "The specified Word document does not exist."
  217. 		End If
  218. 	End If
  219.  
  220. 	' The actual conversion is done by the Doc2Other subroutine
  221. 	If strFileNameIn = "*" Then
  222. 		intOverwriteErrors = 0
  223. 		intConvertedFiles  = 0
  224. 		strMsg             = ""
  225. 		For Each objFileIn In .GetFolder( strParentFolderIn ).Files
  226. 			strFileIn = objFileIn.Path
  227. 			If LCase( .GetExtensionName( strFileIn ) ) = LCase( strExtensionIn ) Then
  228. 				strFileOut = .BuildPath( strParentFolderOut, .GetBaseName( strFileIn ) & "." & strExtensionOut )
  229. 				strMsg     = strMsg & "Converting """ & .GetFileName( strFileIn ) & """ to """ & .GetFileName( strFileOut ) & """ . . ." & vbCrLf
  230. 				strResult  = Doc2Other( strFileIn, strFileOut, strFileTypeOut, blnOverwrite )
  231. 				If IsNull( strResult ) Then
  232. 					intConvertedFiles  = intConvertedFiles  + 1
  233. 				Else
  234. 					intOverwriteErrors = intOverwriteErrors + 1
  235. 					strMsg             = strMsg & "ERROR:" & vbTab & strMsg & vbCrLf
  236. 				End If
  237. 			End If
  238. 		Next
  239. 		WScript.Echo strMsg & vbCrLf & intConvertedFiles & " documents successfully converted, " & intOverwriteErrors & " existing files were skipped." & vbCrLf
  240. 		If intOverwriteErrors > 0 Then
  241. 			Syntax intOverwriteErrors & " existing files were skipped." & vbCrLf & vbTab & "Use '/O' to silently overwrite existing files."
  242. 		End If
  243. 	Else
  244. 		strResult = Doc2Other( strFileSpecIn, strFileSpecOut, strFileTypeOut, blnOverwrite )
  245. 		If Not IsNull( strResult ) Then Syntax strResult
  246. 	End If
  247. End With
  248.  
  249. ' Finished
  250. Set objFSO       = Nothing
  251. Set arrFileTypes = Nothing
  252.  
  253.  
  254. Function Doc2Other( myInputFile, myOutputFile, myFileType, myBoolOverwrite )
  255. 	Dim objDoc, objFSO, objWord, strMsg
  256. 	strMsg = Null
  257. 	Set objFSO = CreateObject( "Scripting.FileSystemObject" )
  258. 	If objFSO.FileExists( myOutputFile ) And Not myBoolOverwrite Then
  259. 		strMsg = """" & objFSO.GetFileName( myOutputFile ) & """ already exists." & vbCrLf & vbTab & "Use '/O' to silently overwrite existing files." & vbCrLf
  260. 	Else
  261. 		On Error Resume Next
  262. 		Set objWord = CreateObject( "Word.Application" )
  263. 		If Err Then
  264. 			Err.Clear
  265. 			strMsg = "Unable to access MS Word. Make sure MS Office is installed" & vbCrLf & vbTab & "(MSI based installation, NOT a ""click-to-run"" installation)."
  266. 		Else
  267. 			objWord.Visible = True
  268. 			objWord.Documents.Open myInputFile
  269. 			If Err Then
  270. 				Err.Clear
  271. 				strMsg = "Unable to open the input document in Microsoft Word."
  272. 			Else
  273. 				Set objDoc = objWord.ActiveDocument
  274. 				objDoc.SaveAs myOutputFile, CLng( myFileType )
  275. 				If Err Then
  276. 					Err.Clear
  277. 					strMsg = "Unable to save the document in the requested format."
  278. 				End If
  279. 				objDoc.Close
  280. 				If Err Then
  281. 				Err.Clear
  282. 					strMsg = strMsg & vbCrLf & vbTab & "Unable to close the input document."
  283. 				End If
  284. 				Set objDoc = Nothing
  285. 			End If
  286. 			objWord.Quit
  287. 			Set objWord = Nothing
  288. 		End If
  289. 		On Error Goto 0
  290. 	End If
  291. 	Doc2Other = strMsg
  292. End Function
  293.  
  294.  
  295. Function IsInGUI( )
  296. 	IsInGUI = Not ( Right( LCase( WScript.FullName ), 12 ) = "\cscript.exe" )
  297. End Function
  298.  
  299.  
  300. Sub Syntax( myMessage )
  301. 	Dim strMsg
  302. 	On Error Resume Next
  303. 	objDoc.Close
  304. 	objWord.Quit
  305. 	Set objDoc       = Nothing
  306. 	Set objWord      = Nothing
  307. 	Set objFSO       = Nothing
  308. 	Set arrFileTypes = Nothing
  309. 	On Error Goto 0
  310. 	strMsg = ""
  311. 	If Trim( " " & myMessage ) <> "" Then strMsg = vbCrLf & "ERROR:" & vbTab & myMessage & vbCrLf
  312. 	' Irregular looking whitespace allows proper alignment in both Console and GUI mode (fixed width vs proportional fonts)
  313. 	strMsg = strMsg _
  314. 	       & vbCrLf _
  315. 	       & "Word2Any.vbs,  Version 1.01" _
  316. 	       & vbCrLf _
  317. 	       & "Open a Microsoft Word document and save it in ""any"" (known) format" _
  318. 	       & vbCrLf & vbCrLf _
  319. 	       & "Usage:  "   & vbTab  & "WORD2ANY.VBS    ""wordfile""  [ ""outfile"" ]  [ options ]" _
  320. 	       & vbCrLf & vbCrLf _
  321. 	       & "Where:  "   & vbTab  & """wordfile""" & vbTab & "Word document(s) to be converted (wildcard" _
  322. 	       & vbCrLf _
  323. 	       & "        "   & vbTab  & "          "   & vbTab & "allowed for file name, e.g. ""*.docx"")" _
  324. 	       & vbCrLf _
  325. 	       & "        "   & vbTab  & """outfile"""  & vbTab & "output file(s) to be created (wildcard allowed" _
  326. 	       & vbCrLf _
  327. 	       & "        "   & vbTab  & "          "   & vbTab & "for file name, e.g. ""*.pdf"" or ""*.html"")" _
  328. 	       & vbCrLf _
  329. 	       & "Options:"   & vbTab  & "/O        "   & vbTab & "silently overwrite existing output file(s)" _
  330. 	       & vbCrLf _
  331. 	       & "        "   & vbTab  & "          "   & vbTab & "(default: abort if output file exists)" _
  332. 	       & vbCrLf _
  333. 	       & "        "   & vbTab  & "/T        "   & vbTab & "list available output file types" _
  334. 	       & vbCrLf _
  335. 	       & "        "  & vbTab  & "/T:type  "     & vbTab & "set output file type (required if ""outfile""" _
  336. 	       & vbCrLf _
  337. 	       & "        "   & vbTab  & "          "   & vbTab & "not specified; type may be number or string)" _
  338. 	       & vbCrLf & vbCrLf _
  339. 	       & "Notes:  "   & vbTab  & "[1]"          & vbTab & "This script requires a ""regular"" (MSI based)" _
  340. 	       & vbCrLf _
  341. 	       & "        "   & vbTab  & "       "      & vbTab & "Microsoft Word installation, it WILL FAIL on" _
  342. 	       & vbCrLf _
  343. 	       & "        "   & vbTab  & "       "      & vbTab & "a ""click-to-run"" installation of MS Office." _
  344. 	       & vbCrLf _
  345. 	       & "        "   & vbTab  & "[2]"          & vbTab & "For Word 2007, to save as PDF or XPS this script" _
  346. 	       & vbCrLf _
  347. 	       & "        "   & vbTab  & "       "      & vbTab & "requires the ""Microsoft Save as PDF or XPS Add-in for" _
  348. 	       & vbCrLf _
  349. 	       & "        "   & vbTab  & "       "      & vbTab & "2007 Microsoft Office programs"", available at:" _
  350. 	       & vbCrLf _
  351. 	       & "        "   & vbTab  & "       "      & vbTab & "www.microsoft.com/en-us/download/details.aspx?id=7" _
  352. 	       & vbCrLf _
  353. 	       & "        "   & vbTab  & "[3]"          & vbTab & "If wildcard ""*"" is used for the Word document, and" _
  354. 	       & vbCrLf _
  355. 	       & "        "   & vbTab  & "       "      & vbTab & "the /O switch is not used, the script will display an" _
  356. 	       & vbCrLf _
  357. 	       & "        "   & vbTab  & "       "      & vbTab & "error message in case an output file already exists," _
  358. 	       & vbCrLf _
  359. 	       & "        "   & vbTab  & "       "      & vbTab & "but it will then continue to convert the next file" _
  360. 	       & vbCrLf _
  361. 	       & "        "   & vbTab  & "       "      & vbTab & "instead of aborting." _
  362. 	       & vbCrLf _
  363. 	       & "        "   & vbTab  & "[4]"          & vbTab & "If Word was already active when this script is started," _
  364. 	       & vbCrLf _
  365. 	       & "        "   & vbTab  & "       "      & vbTab & "the other document(s) will be left alone, and only the" _
  366. 	       & vbCrLf _
  367. 	       & "        "   & vbTab  & "       "      & vbTab & "document opened by this script will be closed." _
  368. 	       & vbCrLf & vbCrLf _
  369. 	       & "Examples:"  & vbTab  & "WORD2ANY.VBS ""D:\folder\myfile.doc"" *.pdf" _
  370. 	       & vbCrLf _
  371. 	       & "        "   & vbTab  & "will save to ""D:\folder\myfile.pdf""" _
  372. 	       & vbCrLf & vbCrLf _
  373. 	       & "        "   & vbTab  & "WORD2ANY.VBS ""D:\folder\myfile.docx"" ""D:\otherfolder\*.rtf""" _
  374. 	       & vbCrLf _
  375. 	       & "        "   & vbTab  & "will save to ""D:\otherfolder\myfile.rtf""" _
  376. 	       & vbCrLf & vbCrLf _
  377. 	       & "        "   & vbTab  & "WORD2ANY.VBS ""D:\folder\myfile.rtf"" ""D:\elsewhere\newfile.xps""" _
  378. 	       & vbCrLf _
  379. 	       & "        "   & vbTab  & "will save to ""D:\elsewhere\newfile.xps""" _
  380. 	       & vbCrLf & vbCrLf _
  381. 	       & "        "   & vbTab  & "WORD2ANY.VBS ""D:\folder\*.doc"" *.html" _
  382. 	       & vbCrLf _
  383. 	       & "        "   & vbTab  & "will save all matching files as HTML to ""D:\folder\""" _
  384. 	       & vbCrLf & vbCrLf _
  385. 	       & "        "   & vbTab  & "WORD2ANY.VBS ""D:\folder\*.doc"" /T:8" _
  386. 	       & vbCrLf _
  387. 	       & "        "   & vbTab  & "same as previous example, but more file types available" _
  388. 	       & vbCrLf & vbCrLf _
  389. 	       & "        "   & vbTab  & "WORD2ANY.VBS /T" _
  390. 	       & vbCrLf _
  391. 	       & "        "   & vbTab  & "will list all available file types" _
  392. 	       & vbCrLf & vbCrLf _
  393. 	       & "Written by Rob van der Woude" _
  394. 	       & vbCrLf _
  395. 	       & "http://www.robvanderwoude.com"
  396. 	WScript.Echo strMsg
  397. 	WScript.Quit 1
  398. End Sub
  399.  

page last uploaded: 2017-08-21, 14:26