'  Script uses MS Word to count instances of a Word, phrase, or text string in a specified Word Document
'  Requires MS Word on the system
'  Doc files may be dragged and dropped onto the script file or its shortcut
'  If script is run without an argument, user can type full path and file name to run

'  Steve Yandl

' ===============================================================================
' ===============================================================================

Const wdDoNotSaveChanges = 0
Const wdFindStop = 0

Dim fso, objWord, objDoc

Set fso = CreateObject("Scripting.FileSystemObject")

'  If a file is dropped on the script, confirm it exists and has a doc extension
'  If a path and file name is typed in, confirm file exists and has a doc extension
'  If supplied file is a doc file, assign full name to strDocPath, otherwise quit script
If WScript.Arguments.Count > 0 Then
   If fso.FileExists(WScript.Arguments.Item(0)) Then
      If fso.GetExtensionName(WScript.Arguments.Item(0)) = "doc" Then
      strDocPath = WScript.Arguments.Item(0)
      Else
      WScript.Echo "File dropped here was not a doc file"
      WSCript.Quit
      End If
   Else
   WScript.Echo "Item dropped here was not a file"
   WScript.Quit
   End If
Else
strTypePath = InputBox("Type path and file name for Word document to check")
   If fso.FileExists(strTypePath) Then
      If fso.GetExtensionName(strTypePath) = "doc" Then
      strDocPath = strTypePath
      Else
      WScript.Echo "The file name you typed in was not a doc file"
      WScript.Quit
      End If
   Else
   WScript.Echo "The file name you typed in does not exist"
   WScript.Quit
   End If
End If

'  Let the user enter the string to search for in the Word document
'  Bail out if nothing gets entered
strSearch = InputBox("Enter the word, phrase, or string to count")
If Not Len(strSearch) > 0 Then WScript.Quit

iStrCount = 0

Set objWord = CreateObject("Word.Application")
Set objDoc = objWord.Documents.Open(strDocPath)

'  Count how many times the string appears in the target document
With objDoc.Content.Find
   .Text = strSearch
   .Format = False
   .Wrap = wdFindStop
   Do While .Execute
      iStrCount = iStrCount + 1
   Loop
End With

'  Report the results
If iStrCount = 1 Then
WScript.Echo strSearch & " appears once in" & vbCrLf & strDocPath
Else
WScript.Echo strSearch & " appears " & iStrCount & " times in" & vbCrLf & strDocPath
End If

'  Clean up
objDoc.Close(wdDoNotSaveChanges)
objWord.Quit
Set objWord = Nothing
Set fso = Nothing