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