Private Const SIG_PATH = "C:\SIGNATURES\"
Private Const SIG_INI = "SIG.INI"
Private Const SEARCH_FOR = "[==insert.signature.file."
Private Const SEARCH_END = "==]"
Public Sub AddSignatureGraphics()
'enable error handler
On Error GoTo AddSignatureGraphics_err
'declare some object variables
Dim docADocument As Document
Dim rngSearchForFound As Range
Dim rngSearchEndFound As Range
Dim rngSignatoryName As Range
Dim rngReplace As Range
'Declare some String Variables
Dim szSignatory As String
Dim szSigFileName As String
'Iterate through each open document
For Each docADocument In Word.Documents
'set each range to some arbitrary range,
'we will make adjustments later
Set rngSearchForFound = docADocument.Content
Set rngSearchEndFound = docADocument.Content
Set rngReplace = docADocument.Content
Set rngSignatoryName = docADocument.Content
'look for the SEARCH_FOR text
rngSearchForFound.Find.Execute findtext:=SEARCH_FOR, Forward:=True
'if we found the SEARCH_FOR text
Do While rngSearchForFound.Find.Found = True
'set the starting point for looking for the SEARCH_END text
'to the place we found the SEARCH_FOR text
rngSearchEndFound.Start = rngSearchForFound.Start
'look for the SEARCH_END text
rngSearchEndFound.Find.Execute findtext:=SEARCH_END, Forward:=True
If rngSearchEndFound.Find.Found = True Then
'we found the SEARCH_END text
'test to make sure it is in the same paragraph as the SEARCH_FOR text,
'if it is not, then we are not interested in it.
If rngSearchEndFound.InRange(rngSearchForFound.Paragraphs(1).Range) Then
'we are interested.
're-define the start and end positions of the range
'to be replaced, based (respectively) on the start
'and end positions of the SEARCH_FOR and
'SEARCH_END text which we found
rngReplace.Start = rngSearchForFound.Start
rngReplace.End = rngSearchEndFound.End
're-define the start and end positions of the range
'where we expect to find the signatory's name,
'based (respectively) on the end
'and start positions of the SEARCH_FOR and
'SEARCH_END text which we found
rngSignatoryName.Start = rngSearchForFound.End
rngSignatoryName.End = rngSearchEndFound.Start
'grab the name of the signatory
szSignatory = Trim(rngSignatoryName.Text)
'look up the corresponding file name for the
'signature file
szSigFileName = szSignatoryNameToFileName(szSignatory)
'Ensure we got a good result (i.e. a filename)
If Len(szSigFileName) Then
'delete the place marker
rngReplace.Delete
'insert the signature file
rngReplace.InlineShapes.AddPicture FileName:=szEnsureTrailingBackSlashOnPath(SIG_PATH) & szSigFileName, _
LinkToFile:=False, SaveWithDocument:=True
End If ' got a file name
End If 'SEARCH_FOR and SEARCH_END markers found were both within the same paragraph
End If 'SEARCH_END marker found
'redefine the starting position for looking for the next SEARCH_FOR marker
rngSearchForFound.Collapse wdCollapseEnd
'look for the next SEARCH_FOR marker
rngSearchForFound.Find.Execute findtext:=SEARCH_FOR, Forward:=True
Loop 'see if we found one
Next docADocument
AddSignatureGraphics_exit:
Set docADocument = Nothing
Set rngSearchForFound = Nothing
Set rngSearchEndFound = Nothing
Set rngReplace = Nothing
Set rngSignatoryName = Nothing
Exit Sub
AddSignatureGraphics_err:
MsgBox "An error occurred in attempting to add the signatures." & vbCrLf & vbCrLf _
& "Error Number : " & Err.Number & vbCrLf _
& "Error Description : " & Err.Description, vbExclamation + vbOKOnly, "Error Adding Signatures", Err.HelpFile, Err.HelpContext
Resume AddSignatureGraphics_exit
End Sub
Private Function szEnsureTrailingBackSlashOnPath(ByVal szPath As String) As String
On Error Resume Next
If Len(szPath) > 0 Then
If Right(szPath, 1) <> "\" Then
szPath = szPath & "\"
End If
End If
szEnsureTrailingBackSlashOnPath = szPath
End Function
Private Function szSignatoryNameToFileName(szSignatory As String) As String
szSignatoryNameToFileName = System.PrivateProfileString(szEnsureTrailingBackSlashOnPath(SIG_PATH) & SIG_INI, "SignatureFiles", szSignatory)
End Function
.
