by Matmonk (2 Submissions)
Category: OLE/COM/DCOM/Active-X
Compatability: Visual Basic 3.0
Difficulty: Advanced
Date Added: Wed 3rd February 2021
Rating: 
(4 Votes)
This code is an example of how to use various functions contained within the Word Application object. To use this code you must first set a reference to the word libary then declare a word application object. This code shows how to use the search/replace functions, how to bold items, how to do a "Save As" from the code and how to insert lines. There are also a few miscellanous methods such as how to tell if a file exists and how to kill it. This piece of code was origonally written as part of a class module and was incorporated into a dll to be used by other application developers that I was working with. I have a few other examples from the class if anyone is interested, please drop me a line. I hope that this saves someone some time in using word. I have not found too many good books or code examples that explain how to use word as an object.
Inputs
the code is looking for a document that was pre-setup as a template. the fields that look like "<
Assumes
make sure that you set a reference to the word object using the Project/References menu. Almost all variables (except those explicitly stated as local) are module level variables private to the class module. all the vbTab constants appended to the strings are used simple to align the text. If anyone knows of a better way to do this, I would love to hear it.
API Declarationsnone -- this was part of a self contained class
' this subroutine/method is used to print the Genstar Public Officals
' quote letter. The method expects no values to be passed and the method has no
' return values.
' Created 08/27/1999 -- JCH
' declare local variables here
Dim objWord As Word.Application
Dim strDocumentSave As String
Dim strSearch(14) As String
Dim strReplace(14) As String
Dim strDocumentName As String
Dim strInsertLine As String
Dim intCounter As Integer
Dim strContactName As String
Dim strSelectedName As String
Dim strFaxNumber As String
Dim intContactNumber As Integer
' instantate the objects
Set objWord = New Word.Application
strDocumentName = "GenStarQuotePOMaster.doc"
' add values to the search array
strSearch(0) = "<
strSearch(1) = "<
strSearch(2) = "<
strSearch(3) = "<
strSearch(4) = "<
strSearch(5) = "<
strSearch(6) = "<
strSearch(7) = "<
strSearch(8) = "<
strSearch(9) = "<
strSearch(10) = "<
strSearch(11) = "<
strSearch(12) = "<
strSearch(13) = "<
strSearch(14) = "<
' now determine the values for the conditional fields
Select Case mvarProviderInfo.ProviderName
Case "General Star Indemnity"
strReplace(8) = "*Annual Premium:" & vbTab & vbTab & vbTab & CStr (Format(mvarPremium, "currency")) & _
vbTab & vbTab & vbTab & vbTab & vbTab & vbTab & vbTab & "$0"
strReplace(9) = "*Loss Control Fee:" & vbTab & vbTab & vbTab & "$0.00" & vbTab & vbTab & vbTab & vbTab & vbTab & vbTab & vbTab & "N/A"
strReplace(10) = "*The above may be subject to state surplus lines taxes and/or fees. Your " _
& "agency is responsible for calculating and remitting the taxes to the state."
strReplace(11) = "Public Officials coverages are being offered by " & mvarProviderInfo.ProviderName
If UCase(mvarTaxState) = "CT" Then
strReplace(11) = "Public Officials coverages are being offered by " & mvarProviderInfo.ProviderName
End If
Case Else
strReplace(8) = "Annual Premium:" & vbTab & vbTab & vbTab & CStr(Format(mvarPremium, "currency")) & _
vbTab & vbTab & vbTab & vbTab & vbTab & vbTab & vbTab & "$0"
strReplace(9) = "Loss Control Fee:" & vbTab & vbTab & vbTab & "$0.00" & vbTab & vbTab & vbTab & vbTab & vbTab & vbTab & vbTab & "N/A"
strReplace(10) = "The above may be subject to state surplus lines taxes and/or fees. Your " _
& "agency is responsible for calculating and remitting the taxes to the state."
strReplace(11) = "Public Officials coverages are being offered by GENERAL STAR NATIONAL (AN A++ Admitted Carrier)" & vbCr
If UCase(mvarTaxState) = "NY" Then
strReplace(11) = strReplace(11) & "COVERAGE IS OFFERED THROUGH THE NY FEE TRADE ZONE" & vbCr
End If
End Select
' bring up the form to allow the user to select the producer contact info
Load frmContactSelect
frmContactSelect.Visible = False
DoEvents
' loop through the Producer contacts and add the names to the listbox on the form
For intCounter = 1 To mvarProducerInfo.Contacts.Count
With mvarProducerInfo.Contacts(intCounter)
strContactName = .FirstName & Space$(1) & .LastName
frmContactSelect.lstNames.AddItem strContactName
strContactName = ""
End With
Next
' show the form modally to allow the user to select the contact
frmContactSelect.Show vbModal
strSelectedName = frmContactSelect.lstNames.List(frmContactSelect.lstNames.ListIndex)
intContactNumber = frmContactSelect.lstNames.ListIndex + 1
Unload frmContactSelect
Set frmContactSelect = Nothing
' add values to the replace array
strFaxNumber = mvarProducerInfo.Contacts(intContactNumber).FaxNumber
strReplace(0) = mvarProducerInfo.ProducerName
strReplace(1) = "(" & Left$(strFaxNumber, 3) & ")" & Space$(1) & Mid$(strFaxNumber, 4, 3) & "-" & Mid$(strFaxNumber, 7)
strReplace(2) = mvarInsuredName
strReplace(3) = mvarInsuredState
strReplace(4) = mvarSLOBDescription
strReplace(5) = CStr(Format(mvarLimitPerOccurance, "currency")) & Space$(1)
strReplace(6) = CStr(Format(mvarLimitAnnualAgg, "currency")) & Space$(1)
strReplace(7) = CStr(Format(mvarDeductible, "currency")) & Space$(1)
strReplace(12) = "0" ' for now
strReplace(13) = strSelectedName
strReplace(14) = mvarUnderwriterName
' assign a value for the saved document name
strDocumentSave = App.Path & "\letters\pipssavedletters\" _
& StrConv(mvarProducerInfo.ProducerName, vbProperCase) & " GenStarPOQuote " & _
Format(Date, "mddyy") & ".doc"
' see if save name document exists, if so delete it
If Dir(strDocumentSave) <> "" Then Kill strDocumentSave
' check to see if the master document for this letter exists
If Dir(App.Path & "\letters\" & strDocumentName) = "" Then
RaiseEvent MasterDocumentNotFound("Unable to find " & strDocumentName & " file.")
objWord.Quit SaveChanges:=wdDoNotSaveChanges
Set objWord = Nothing
End If
' add this information to the GenStarQuote master document
objWord.Documents.Open App.Path & "\letters\" & strDocumentName
objWord.ActiveWindow.WindowState = wdWindowStateNormal
For intCounter = 0 To 12
With objWord.ActiveDocument.Content.Find
.Text = strSearch(intCounter)
.Replacement.Text = strReplace(intCounter)
.Forward = True
.Execute Replace:=wdReplaceAll
End With
Next
' insert the rest of the text needed if the provider it genstar indemnity
If mvarProviderInfo.ProviderName = "General Star Indemnity" Then
Select Case UCase(mvarTaxState)
Case "NY"
strInsertLine = " (An A++ Rated Surplus Lines Carrier). YOUR " & _
"AGENCY IS RESPONSIBLE FOR MAKING SURPLUS LINES FILINGS WITH THE STATE. PLEASE PROVIDE A COPY OF " & _
" YOUR SURPLUS LINES LICENSE IF NOT PREVIOUSLY PROVIDED."
Case "CT"
strInsertLine = "(An A++ Rated Admitted Carrier in Connecticut). YOUR AGENCY IS RESPONSIBLE FOR MAKEING SURPLUS LINES " _
& " FILINGS WITH THE STATE. PLEASE PROVIDE A COPY OF YOUR SURPLUS LINES LICENSE IF NOT PREVIOUSLY PROVIDED."
End Select
objWord.Selection.Find.Text = mvarProviderInfo.ProviderName
objWord.Selection.Find.Execute
objWord.Selection.InsertAfter strInsertLine
objWord.Selection.Font.Bold = False
End If
' bold the provider name in the document
With objWord.ActiveDocument.Content.Find
.Text = UCase(mvarProviderInfo.ProviderName)
.Replacement.Text = mvarProviderInfo.ProviderName
.Replacement.Font.Bold = True
.Forward = True
.Execute Replace:=wdReplaceAll
End With
' if the tax state equals new york, then we must remove part of one phrase
If UCase(mvarTaxState) = "NY" Then
With objWord.ActiveDocument.Content.Find
.Text = "non-monetary"
.Replacement.Text = Space$(1)
.Replacement.Font.Bold = True
.Forward = True
.Execute Replace:=wdReplaceAll
End With
End If
objWord.Selection.Collapse wdCollapseEnd
' save the document with a new name
objWord.Documents(strDocumentName).SaveAs strDocumentSave, , , , True
' make the document visible
objWord.Application.Visible = True
VBcoders