Open word.
This script uses an ini file for configuration. It will read the inifile and get the directories to process.
This script was used to open word documents. WOrd was configured to automatically run a VBA macro when it starts. The VBA macro makes some changes to the document and if the document is not readonly the documents are saved by the VBscript. Word has to be installed on the pc that runs this script!
'*****************************************************************
'** Script: OpenWord
'** Version: 1.0
'** Created: date / time
'** Author: Adriaan Westra
'** E-mail:
'**
'** Purpose / Comments:
'** opens word documents and save them.
'**
'** Changelog :
'** date / time : Reason
'** 22-05-2006 07:44 : Initial version
'**
'*****************************************************************
'*****************************************************************
'** Declaration of variables used by the template
Dim Version : Version = "1.0" ' Script version
Dim Author : Author = "Adriaan Westra"
Dim Email : Email = ""
Dim Logging : Logging = "off"
Dim strScript ' scriptname
Dim strPath ' Script Startup path
Dim FSO ' File System Object
'*****************************************************************
'** Declaration of constants
'** FileAcces
Const ForReading = 1
Const ForWriting = 2
Const ForAppend = 8
'** Database Access
Const adOpenKeyset = 1
Const adOpenDynamic = 2
Const adLockPessimistic = 2
Const adCmdText = 1
'** Domain access
Const GROUP_TYPE_GLOBAL_GROUP = 2
Const GROUP_TYPE_LOCAL_GROUP = 4
Const GROUP_TYPE_SECURITY_ENABLED = &h80000000
Const GROUP_TYPE_UNIVERSAL_GROUP = 8
'** Excel
Const xl3DPie = -4102
Const xlAscending = 1
Const xlAutoActivate = 3
Const xlBottom = -4107
Const xlCellValue = 1
Const xlCenter = -4108
Const xlColorIndexNone = -4142
Const xlColumns = 2
Const xlContinuous = 1
Const xlDataLabelsShowPercent = 3
Const xlDataLabelsShowValue = 2
Const xlDescending = 2
Const xlDown = -4121
Const xlEdgeBottom = 9
Const xlEdgeLeft = 7
Const xlEdgeRight = 10
Const xlEdgeTop = 8
Const xlGreaterEqual = 7
Const xlGuess = 0
Const xlInsideHorizontal = 12
Const xlInsideVertical = 11
Const xlLeft = -4131
Const xlLineStyleNone = -4142
Const xlLocationAsNewSheet = 1
Const xlSolid = 1
Const xlThin = 2
Const xlTopToBottom = 1
Const xlYes = 1
'** Active Directory / Exchange
Const ADS_RIGHT_EXCH_MODIFY_USER_ATT = 2
Const ADS_RIGHT_EXCH_MAIL_SEND_AS = 8
Const ADS_RIGHT_EXCH_MAIL_RECEIVE_AS = 16
Const ADS_SID_WINNT_PATH = 5
Const ADS_SID_HEXSTRING = 1
Const ADS_PROPERTY_APPEND = 3
'** Reggistry constants
Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
'*****************************************************************
'** Add Error Handling
on error resume Next
'*****************************************************************
'** Make sure the script is started with cscript
If InStr(wscript.FullName, "wscript.exe") > 0 Then
MsgBox "Please run this script with cscript.exe." & Chr(13) & _
"For example : cscript " & WScript.ScriptName & " /?", _
vbExclamation, WScript.ScriptName
WScript.Quit(1)
End If
'*****************************************************************
'** Get startup path from scriptfullname
Pos = InStr(wscript.ScriptFullName, wscript.ScriptName)
strPath = Mid(wscript.ScriptFullName,1,Pos - 1)
Pos = InStr(wscript.ScriptName, ".")
strScript = Mid(wscript.ScriptName,1,Pos - 1)
'*****************************************************************
'** Get commandline parameters
Set Args = Wscript.Arguments
'*****************************************************************
'** No commandline parameters, display inputbox
'If Args.Count = 0 Then
' Var = InputBox("Give Var : ",wscript.scriptname, "Default Value")
' If Var = "" Then
' WScript.Echo
' WScript.Echo "Error var is not filled!! "
' WScript.Echo
' DisplayHelp
' WScript.Quit(1)
' End if
'End if
'*****************************************************************
'** Check for help in commandline parameters
If Args.Count = 1 Then
If InStr(Args(0),"/?") > 0 Or InStr(UCase(Args(0)),"/H") > 0 _
Or InStr(UCase(Args(0)),"/HELP") > 0 Then
DisplayHelp
Wscript.quit(0)
End if
End If
'*****************************************************************
'** There are commandline parameters, parse and check them
For Each arg in args
If arg = "/log" Then
Logging = "on"
End If
Next
'*****************************************************************
'** Declare Variables
Dim Var ' Explanation for vars
Dim LogDir : LogDir = strPath & "VBSlog" ' Directory for logging
Dim LogFileName : LogFileName = LogDir & "\" & strScript & ".log"
Dim LogFile
'*****************************************************************
'** Log Options
If Logging = "on" Then
Set FSO = WScript.CreateObject("Scripting.FileSystemObject")
If Not fso.FolderExists(LogDir) Then
Set LogFolder = Fso.CreateFolder(LogDir)
End If
Set LogFile = FSO.OpenTextFile(LogFileName, ForWriting, True)
LogLine = Now & " ==> Start of script : " & Wscript.scriptname
LogFile.WriteLine LogLine
End If
'*****************************************************************
'** Start of script! Add Code after this Line
IniFilename = "openword.ini"
'*****************************************************************
'** Read file extension to process
strExt = ReadINI(IniFileName, "Parameters", "FileExtension")
'*****************************************************************
'** Read number of directories to process
iDirCount = ReadINI(IniFileName, "Directories", "DirCount")
'*****************************************************************
'** Create shortcuts for applications
For i = 1 to iDirCount
strDir = ReadINI(IniFileName, "Directories", "Dir" & i)
wscript.echo "Processing ==> " & strdir
OpenWordDocs strDir
listdir strDir ' loop through subdirs
Next
'*****************************************************************
'** End of script
If Logging = "on" Then
LogLine = Now & " ==> End of script : " & Wscript.scriptname
LogFile.WriteLine LogLine
LogFile.Close
End If
Wscript.Quit()
'*****************************************************************
'** Sub: DisplayHelp
'** Version: 1.0
'** Created: 24-03-2003 8:22
'** Author: Adriaan Westra
'** E-mail:
'**
'** Purpose / Comments:
'** Display help for script
'**
'** Arguments :
'**
'** Wijzigingslog :
'** 24-03-2003 8:22 : Initiële versie
'**
'*****************************************************************
Sub DisplayHelp()
strComment = string(2,"*")
strCmntLine = String(79, "*")
wscript.echo strCmntline
wscript.echo strComment
wscript.echo strComment & " Online help for " & _
Wscript.scriptname & " version : " & Version
wscript.echo strComment
wscript.echo strComment & " Usage : cscript " & _
Wscript.scriptname
wscript.echo strComment
wscript.echo strComment & " Purpose : Open word and " & _
" save the document."
wscript.echo strComment
wscript.echo strComment & " Author : " & Author
wscript.echo strComment & " E-mail : " & Email
wscript.echo strComment
wscript.echo strCmntline
End Sub
'*****************************************************************
'** Function: ReadIni
'** Version: 1.1
'** Created: 19-03-2003 11:02
'** Author: Adriaan Westra
'** E-mail:
'**
'** Purpose / Comments:
'** Reads a value from an iniFile
'**
'** Arguments :
'** strINIFile :Name of the IniFile to read
'** strSection :Section in the inifile to read from
'** strKey :Key of the value to read
'**
'** Changelog :
'** 19-03-2003 11:15 : Initial version
'** 19-03-2003 11:25 : Built in UpperCase Check
'**
'*****************************************************************
Function ReadINI(strINIFile, strSection, strKey)
Dim objFSO, objTextFile, strLine
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.OpenTextFile(strINIFile)
'loop through each line and check for key value
Do While Not objTextFile.AtEndOfStream
strLine = objTextFile.ReadLine
'wscript.echo strLine
If UCase(strLine) = UCase("[" & strSection & "]") Then
Do While Not objTextFile.AtEndOfStream
strLine = objTextFile.ReadLine
If UCase(Left(strLine, Len(strKey) + 1)) = _
UCase(strKey & "=") Then
ReadINI = Mid(strLine, InStr(strLine, "=") + 1)
Exit do
End If
Loop
Exit Do
End If
Loop
objTextFile.Close
End Function
'*****************************************************************
'** Function: Errorhandling
'** Version: 1.0
'** Created: 09-04-2003 11:44
'** Author: Adriaan Westra
'** E-mail:
'**
'** Purpose / Comments:
'**
'** Handle errors and displays an error message.
'**
'** Change Log :
'**
'** 09-04-2003 11:49 : Initial Version
'**
'** Arguments :
'**
'** None
'**
'** Returns :
'**
'** Nothing
'**
'*****************************************************************
Sub ErrorHandling()
Select Case err.number
Case 0
Exit sub
Case -2147467259
wscript.echo "Database is gelocked"
wscript.quit(1)
Case else
wscript.echo err.number & " " & err.description
err.clear
End select
End Sub
'*****************************************************************
'** Function: ListDir
'** Version: 1.0
'** Created: 03-12-2004 8:50
'** Author: Adriaan Westra
'** E-mail:
'**
'** Purpose / Comments:
'**
'** List all subdirs
'**
'** Change Log :
'**
'** 03-12-2004 8:50 : Initial Version
'**
'** Arguments :
'**
'** strDir Directory to list
'**
'** Returns :
'**
'** Nothing
'**
'*****************************************************************
Sub ListDir( strDir)
Set objFs = WScript.CreateObject("Scripting.FileSystemObject")
Set objFolder = objFS.GetFolder(strDir)
If objFolder.IsRootFolder Then
wscript.echo "Processing ==> " & strdir
OpenWordDocs strDir
End if
for each objSubFolder in objFolder.SubFolders
If ObjSubFolder.Parentfolder.IsRootFolder Then
wscript.echo "Processing ==> " _
& ObjSubFolder.Parentfolder & ObjSubFolder.Name
OpenWordDocs ObjSubFolder.Parentfolder & ObjSubFolder.Name
Else
wscript.echo "Processing ==> " _
& ObjSubFolder.Parentfolder & "\" & ObjSubFolder.Name
OpenWordDocs ObjSubFolder.Parentfolder & "\" & ObjSubFolder.Name
End if
listdir ObjSubFolder.Parentfolder & "\" & ObjSubFolder.Name
Next
End Sub
'*****************************************************************
'** Function: OpenWorddocs
'** Version: 1.0
'** Created: 22-05-2006 08:10
'** Author: Adriaan Westra
'** E-mail:
'**
'** Purpose / Comments:
'**
'** Open a Word Document and if not readonly save it.
'**
'** Change Log :
'**
'** 22-05-2006 08:11 : Initial Version
'**
'** Arguments :
'**
'** strdir Directory to open files in.
'**
'** Returns :
'**
'** Nothing
'**
'*****************************************************************
Sub OpenWordDocs( strDir)
Set ObjFSWord = WScript.CreateObject("Scripting.FileSystemObject")
Set objWordFolder = objFSWord.GetFolder(strDir)
Set objRegExp = New RegExp
ObjRegExp.Pattern = strExt
objRegexp.IgnoreCase = True
For Each objWordFile in objWordFolder.Files
If objRegexp.test(objWordFile.name) Then
wscript.echo strDir & "\" & objWordFile.name
Set objWord = CreateObject("word.application")
objWord.visible = True
objWord.Documents.Open strDir & "\" & objWordFile.name
If Not objWord.Activedocument.ReadOnly Then
objWord.ActiveDocument.save
End If
objWord.ActiveDocument.Close
objword.quit
End If
Next
Set objWordFolder = nothing
Set objFSWord = Nothing
End Sub
The inifile should look like this:
[Parameters] ; file extension to look for FileExtension=.doc [directories] ; Number of directories to process DirCount=2 ; dirX is root directory to process dir1=c:\word\test dir2=c:\word\docs
