• Home
 · 
• OLE/COM/DCOM/Active-X
 · 
• Using VB code to access MS Word Functions

Using VB code to access MS Word Functions

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 "<>" are place holders in the template. The replacement values were generated by stored procedures run against a sql server database. If there is interest I will post the ado routines that I used to get the data.

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 Declarations
none -- this was part of a self contained class

Rate Using VB code to access MS Word Functions

• 1
• 2
• 3
• 4
• 5

(4(4 Vote))

' 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