The Hodge Bloge :: Using COM Automation to create a word document and attach to a Rich Text field.

Another recent question on the notes.net forum asks how to attach a word document into a new form from a document template. I did this with an application I wrote a few years ago, Here is excerpts from a script as an example on how to do this. This script finds a word document template located in another document, creates a new instance of that template as a document, replaces the values of some form fields, then saves the new document, and attaches it in a new document. This script is something I use for a specific task, I tried to pare it down to only necessary parts, but its not at all generic enough to just use, so you'll have to tweak it to suit your needs, but it will give you the idea.

Email me if you want the design guide I give users to show them how to create word document templates to be used with this script.

Sub Click(Source As Button)
On Error Goto Handler

Dim ws As New NotesUIWorkspace
Dim session As New NotesSession

Dim db As NotesDatabase
Set db = session.CurrentDatabase

Dim uidoc As NotesUIDocument
Dim CommBlast As NotesDocument

Set uidoc = ws.CurrentDocument
Set CommBlast = uidoc.Document

Dim smatch As NotesDocument
Set smatch = db.GetDocumentByUNID(CommBlast.ParentUNID(0))
Set worder = smatch

Dim Searches As NotesView
Set Searches = db.GetView("($SearchCats)")

Dim XResults As NotesDocumentCollection
Dim BLRecipients As NotesItem
Set BLRecipients = CommBlast.GetFirstItem("BLRecipients")

Dim UseTemplate As Variant

' Retrieve Template
If Trim(CommBlast.BLTempate(0)) <> "" Then
UseTemplate = True
Else
UseTemplate = False
End If

If UseTemplate Then
Dim Templates As NotesView
Set Templates = db.GetView("DTempLookup")

Dim TemplateDoc As NotesDocument
Set TemplateDoc = Templates.GetDocumentByKey(CommBlast.BLTemplate(0))

' Detach Template File to Data Directory...
Dim NDir As String
NDir = GetNotesDataDirectory()
NDir = NDir + "EM10\"

Dim TemplateField As NotesRichTextItem
Set TemplateField = TemplateDoc.GetFirstItem("Template")
Dim Template As NotesEmbeddedObject
Set Template = TemplateField.EmbeddedObjects(0)
Call Template.ExtractFile(NDir + "temp\" + Template.Name)

CommBlast.WordDocs = NDir + "temp\" +Template.Name
Dim niWordDocs As NotesItem
Set niWordDocs = CommBlast.GetFirstItem("WordDocs")

Dim WordApp As Variant
Dim WordDoc As Variant

Set WordApp = CreateObject("Word.Application") 'Create Word object
End If

Dim SRF As NotesDocument
Dim FormField As NotesItem
Dim FSDoc As NotesDocument
Dim KeyVals(1 To 2) As String

Dim CommDoc As NotesDocument
Dim sBody As NotesRichTextItem
Dim Body As NotesRichTextItem
Dim WDFileName As String

Dim FileMoniker As String
Dim Enclosures As NotesRichTextItem

Forall recips In BLRecipients.Values
KeyVals(1) = CommBlast.ResultKey(0)
KeyVals(2) = recips
Set XResults = Searches.GetAllDocumentsByKey(KeyVals)

Set SRF = XResults.GetFirstDocument()

While Not SRF Is Nothing
Print "SRF Not Nothing"
Set FSDoc = db.GetDocumentByUNID(SRF.ParentDocumentUNID)

If UseTemplate Then
Set WordDoc = WordApp.documents.add(NDir + "temp\" + Template.Name)

'Set WordDoc = WordApp.activedocument 'Get a handle for the active document

Forall x In worddoc.FormFields
Set FormField = Nothing
If Left$(x.Result, 2) = "FS" Then
Set FormField = FSDoc.GetFirstItem(x.Result)
Elseif Left$(x.Result, 2) = "WO" Then
Set FormField = worder.GetFirstItem(x.Result)
Elseif Left$(x.Result, 2) = "SS" Then
Set FormField = SRF.GetFirstItem(x.Result)
Elseif Left$(x.Result, 2) = "BL" Then
Set FormField = CommBlast.GetFirstItem(x.Result)
End If

If FormField Is Nothing Then
Messagebox "The specified template contains fields not found on the Field Staff, Work Order, Staff Schedule, or Comm Blast Form. Please correct this error before continuing. (" + x.Result + ")", MB_OK + MB_ICONSTOP, AppName()
WordApp.quit
Exit Sub
End If

x.result = FormField.Text
End Forall
End If

Set CommDoc = db.CreateDocument()
CommDoc.Form = "CBL"
CommDoc.SendTo = FSDoc.FSFirstName(0) + " " + FSDoc.FSLastName(0)
CommDoc.FSFirstName = FSDoc.FSFirstName(0)
CommDoc.FSLastName = FSDoc.FSLastName(0)
CommDoc.Subject = CommBlast.BLSubject(0)
CommDoc.CBToBeSent = "Send"
CommDoc.ResultKey = CommBlast.ResultKey(0)
Call CommDoc.Save(True, False, True)

Set Body = CommDoc.CreateRichTextItem("Body")

If UseTemplate Then
FileMoniker = CommDoc.UniversalID
FileMoniker = Right$(FileMoniker, 4)
WDFileName = NDir + "temp\" + FSDoc.FSFirstName(0)+ " " + FSDoc.FSLastName(0) + " " + CommBlast.WOProgramName(0) + " " + FileMoniker + ".doc"
Call WordDoc.SaveAs(WDFileName)
Call WordDoc.PrintOut()
Call WordDoc.Close

Call Body.EmbedObject(EMBED_ATTACHMENT, "", WDFileName)
End If
Set Enclosures = CommBlast.GetFirstItem("Enclosures")
If Not Enclosures Is Nothing Then
Call Body.AppendRTItem(Enclosures)
End If

Call CommDoc.MakeResponse(FSDoc)
Call CommDoc.Sign()
Call CommDoc.Save(True, False, True)

If UseTemplate Then
Call niWordDocs.AppendToTextList(WDFileName)
End If

Set SRF = XResults.GetNextDocument(SRF)
Wend
End Forall

If UseTemplate Then
Call WordApp.Quit
Yield

On Error Resume Next
Forall wdcs In niWordDocs.Values
Kill wdcs
End Forall
On Error Goto Handler

doc.WordDocs = ""
End If
Call Doc.Save(True, False, True)

Call uidoc.Refresh

Exit Sub

Handler:
Messagebox "Err #" + Str$(Err) + " on line #" + Str$(Erl) + " :: " + Error$(Err) + ". Please write down this error and contact ZetaOne @ 866.379.9100", MB_ICONSTOP + MB_OK, AppName()

If UseTemplate Then
On Error Resume Next

WordApp.Quit
Yield

Forall wdcs In niWordDocs.Values
Kill wdcs
End Forall
doc.WordDocs = ""
Call Doc.Save(True, False, True)
On Error Goto Handler
End If

Exit Sub
End Sub