' ========================================================================================================================
'                                 ____,__,  __,  ____,_,  _,  ____ ____,__, ,____,____,
'                                (-/_|(-|  (-|  (-|_,(-|\ |  (-|__|-/_|( |_/(-|_,(-|__)
'                                _/  |,_|__,_|__,_|__,_| \|,  _|__)/  |,_| \,_|__,_|  \,
'
'                                             Copyright � 2008 Allen Baker
'
' ------------------------------------------------------------------------------------------------------------------------
' File:          M011_WordUtils
' Originator:    Allen Baker (2008.11.23 16:27)
' ------------------------------------------------------------------------------------------------------------------------
' $RCSfile$
' $Revision$
' $Date$
' ========================================================================================================================
'
Option Explicit



' ========================================================================================================================
' Description
'    This module provides miscellaneous utility routines and functions that operate on Word objects and variables.
' ========================================================================================================================



' =====================================================================================================================
' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<[  Miscellaneous  ]>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
' =====================================================================================================================



' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This subroutine replaces all instances of pOldString with pNewString on all pages in the current Word
' document. It is not case sensitive.
'
' param
'    pOldString is the string to replace
' param
'    pNewString is the string to replace all instances of pOldString with.
' -----------------------------------------------------------------------------------------------------------
Public Function documentSubstringReplace(pWordApp As Word.Application, pOldString As String, pNewString As String) As Boolean
   gMsg(1) = ""
   On Error GoTo ErrHandler
   documentSubstringReplace = False
   '
   ' ==============================================================================================
   ' search the text
   ' ----------------------------------------------------------------------------------------------
   pWordApp.ActiveDocument.Select
   pWordApp.Selection.Find.ClearFormatting
   With pWordApp.Selection.Find
      .Text = pOldString
      .Replacement.Text = pNewString
      .Forward = True
      .Wrap = wdFindContinue
      .Format = False
      .MatchCase = False
      .MatchWholeWord = False
      .MatchWildcards = False
      .MatchSoundsLike = False
      .MatchAllWordForms = False
   End With
   Call pWordApp.Selection.Find.Execute(Replace:=Word.WdReplace.wdReplaceAll)
   '
   ' ==============================================================================================
   ' search the hyperlinks
   ' ----------------------------------------------------------------------------------------------
   Dim hLink As Word.Hyperlink
   For Each hLink In pWordApp.ActiveDocument.Hyperlinks
      hLink.Address = Replace(hLink.Address, pOldString, pNewString)
   Next hLink
   documentSubstringReplace = True
   Exit Function

ErrHandler:
   gMsg(1) = "documentSubstringReplace: " & Err.Number & ": " & Err.Description
   documentSubstringReplace = False
End Function



' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This subroutine replaces all instances of each pOldString with its corresponding pNewString on all pages
' in the specified Word document. It is not case sensitive.
'
' param
'    pFilePath is the pathname of the Word file to change
' param
'    pOldStrings is an array of the strings to replace
' param
'    pNewStrings is an array of the strings to replace all instances of the corresponding pOldStrings with.
' -----------------------------------------------------------------------------------------------------------
Public Function wordFileSubstringsReplace(pWordApp As Word.Application, pFilePath As String, pOldStrings() As String, pNewStrings() As String) As Boolean
   Dim found As Boolean
   gMsg(1) = ""
   On Error GoTo ErrHandler
   wordFileSubstringsReplace = False
   If fileExists(pFilePath) Then
      '
      ' ==============================================================================================
      ' open the document
      ' ----------------------------------------------------------------------------------------------
      pWordApp.documents.Open pFilePath
      '
      ' ==============================================================================================
      ' do the string replacements
      ' ----------------------------------------------------------------------------------------------
      Dim j As Long
      For j = LBound(pOldStrings) To UBound(pOldStrings)
         If Not documentSubstringReplace(pWordApp, pOldStrings(j), pNewStrings(j)) Then
            gMsg(1) = "wordFileSubstringsReplace: Error processing file: " & pFilePath & ": " &  gMsg(1)
            wordFileSubstringsReplace = False
            Exit Function
         End If
      Next j
      '
      ' ==============================================================================================
      ' save it, and close it.
      ' ----------------------------------------------------------------------------------------------
      pWordApp.ActiveDocument.Save
      pWordApp.ActiveDocument.Close
   End If
   wordFileSubstringsReplace = True
   Exit Function

ErrHandler:
   gMsg(1) = "wordFileSubstringsReplace: Error processing file: " & pFilePath & ": " & Err.Number & ": " & Err.Description
   wordFileSubstringsReplace = False
End Function



' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This subroutine searches the entire current document for any cell containing the specified substring. It
' is not case sensitive.
'
' return
'    This function returns True if a cell is found in the document that contains the given substring,
'    otherwise, it returns False
'
' param
'    pStringToFind is the string to search for
' -----------------------------------------------------------------------------------------------------------
Public Function documentContainsSubstring(pWordApp As Word.Application, pStringToFind As String) As Boolean
   gMsg(1) = ""
   On Error GoTo ErrHandler
   documentContainsSubstring = False
   '
   ' ==============================================================================================
   ' search the text
   ' ----------------------------------------------------------------------------------------------
   pWordApp.ActiveDocument.Select
   pWordApp.Selection.Find.ClearFormatting
   With pWordApp.Selection.Find
      .Text = pStringToFind
      .Replacement.Text = ""
      .Forward = True
      .Wrap = wdFindContinue
      .Format = False
      .MatchCase = False
      .MatchWholeWord = False
      .MatchWildcards = False
      .MatchSoundsLike = False
      .MatchAllWordForms = False
   End With
   documentContainsSubstring = pWordApp.Selection.Find.Execute
   If documentContainsSubstring Then
      Exit Function
   End If
   '
   ' ==============================================================================================
   ' search the hyperlinks
   ' ----------------------------------------------------------------------------------------------
   Dim hLink As Word.Hyperlink
   For Each hLink In pWordApp.ActiveDocument.Hyperlinks
      documentContainsSubstring = containsSubstring(hLink.Address, pStringToFind)
      If documentContainsSubstring Then
         Exit Function
      End If
   Next hLink
   documentContainsSubstring = False
   Exit Function

ErrHandler:
   gMsg(1) = "documentContainsSubstring: " & Err.Number & ": " & Err.Description
   documentContainsSubstring = False
End Function



' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This subroutine searches the specified Word file for any cell containing any of the specified substrings.
' It is not case sensitive.
'
' return
'    This function returns True if a cell is found in the Word file that contains any of the given
'    substrings, otherwise, it returns False
'
' param
'    pFilePath is the pathname of the Word file to search
' param
'    pStringsToFind is an array of the strings to search for
' -----------------------------------------------------------------------------------------------------------
Public Function wordFileContainsSubstrings(pWordApp As Word.Application, pFilePath As String, pStringsToFind() As String) As Boolean
   Dim found As Boolean
   gMsg(1) = ""
   On Error GoTo ErrHandler
   found = False
   If fileExists(pFilePath) Then
      '
      ' ==============================================================================================
      ' open the document
      ' ----------------------------------------------------------------------------------------------
      pWordApp.documents.Open pFilePath
      '
      ' ==============================================================================================
      ' do the string replacements
      ' ----------------------------------------------------------------------------------------------
      Dim j As Long
      For j = LBound(pStringsToFind) To UBound(pStringsToFind)
         found = documentContainsSubstring(pWordApp, pStringsToFind(j))
         If found Then Exit For
         '
         ' ==============================================================================================
         ' if the search returned False, it could either mean the document was searched and the string
         ' was not found or it can mean that there was an error during the document search.   To see if
         ' it was an error, test to see if anything has been put into gMsg.
         ' ----------------------------------------------------------------------------------------------
         If gMsg(1) <> "" Then
            gMsg(1) = "wordFileContainsSubstrings: Error processing file: " & pFilePath & ": " &  gMsg(1)
            wordFileContainsSubstrings = False
            Exit For
         End If
      Next j
      '
      ' ==============================================================================================
      ' close the document and exit the word app
      ' ----------------------------------------------------------------------------------------------
      pWordApp.ActiveDocument.Close
   End If
   wordFileContainsSubstrings = found
   Exit Function

ErrHandler:
   gMsg(1) = "wordFileContainsSubstrings: Error processing file: " & pFilePath & ": " & Err.Number & ": " & Err.Description
   wordFileContainsSubstrings = False
End Function