Hello,
How can I show the doclink icon in a word document ?
When there’s attachments it prints but doclinks are different. I tryed the example in Lotus Notes help but there is also an error in the function CreateNavigator, any ideas ?!?!?!
Here is the code:
Sub Click(Source As Button)
Dim doc As NotesDocument
Dim workspace As New NotesUIWorkspace
Dim uidoc As NotesUIDocument
Dim session As New NotesSession
Dim objword1 As Variant
Dim MyRange As Variant
Dim attach_name As Variant
Dim rtitem As Variant
Dim status As String
Dim rti As NotesRichTextItem
Dim rtnav As NotesRichTextNavigator
Dim rtlink As NotesRichTextDocLink
Set objword1 = CreateObject("word.application")
Set uidoc = workspace.CurrentDocument
Set doc = uidoc.Document
With objword1
.Visible = True
.Documents.add("c:\program files\microsoft office\ecco\templates\notes\new article.dot")
.ActiveDocument.Bookmarks("article").Select
.Selection.Text = uidoc.FieldGetText( "article" )
.ActiveDocument.Bookmarks("productgroup").Select
.Selection.Text = uidoc.FieldGetText( "grpnumber" )
.ActiveDocument.Bookmarks("mouldnumber").Select
.Selection.Text = uidoc.FieldGetText( "mouldnumber" )
.ActiveDocument.Bookmarks("mould").Select
.Selection.Text = uidoc.FieldGetText( "mould" )
.ActiveDocument.Bookmarks("sole").Select
.Selection.Text = uidoc.FieldGetText( "material" )
status = ""
For i=0 To Ubound(doc.GetItemValue("status"))
If doc.GetItemValue("status")(i)="OK Technique" Then
status = status + doc.GetItemValue("status")(i) + " on " + doc.GetItemValue("who_ok1")(0) + Chr(13)
Elseif doc.GetItemValue("status")(i)="OK Quality" Then
status = status + doc.GetItemValue("status")(i) + " on " + doc.GetItemValue("who_ok2")(0) + Chr(13)
Else
status = status + doc.GetItemValue("status")(i) + Chr(13)
End If
Next
If status <> "" Then
.ActiveDocument.Bookmarks("status1").Select
.Selection.Text = status
End If
Set MyRange = .ActiveDocument.Content
.ActiveDocument.Tables.Add MyRange, uidoc.FieldGetText( "lines" )+1, 3
.ActiveDocument.Tables(1).Columns(1).Width=179
.ActiveDocument.Tables(1).Columns(2).Width=470
.ActiveDocument.Tables(1).Columns(3).Width=60
.ActiveDocument.Tables.Item(1).Cell(1, 1).Range.InsertAfter "Parameter"
.ActiveDocument.Tables.Item(1).Cell(1, 2).Range.InsertAfter "Comments/Reports (links-attachments)"
.ActiveDocument.Tables.Item(1).Cell(1, 3).Range.InsertAfter "Status"
With .ActiveDocument.Tables(1).Range
.Rows.Borders.Enable = True
.Columns.Borders.Enable = True
End With
With .ActiveDocument.Tables(1).Rows(1).Range
.Font.Size = 10
.Bold = True
End With
For i=1 To uidoc.FieldGetText( "lines" )
parameter = "parameter" + i
result = "result" + i
status = "status" + i
attach_name=""
.ActiveDocument.Tables.Item(1).Cell(i+1, 1).Range.InsertAfter doc.GetItemValue(parameter)(0)
Set rtitem = doc.GetFirstItem( result )
If ( rtitem.Type = RICHTEXT And Isarray(rtitem.EmbeddedObjects) ) Then
Forall o In rtitem.EmbeddedObjects
If ( o.Type = EMBED_ATTACHMENT ) Then
attach_name = attach_name + Chr(10) + o.name
End If
End Forall
End If
Set rti = doc.GetFirstItem( "result1" )
Set rtnav = rti.CreateNavigator
Do
Set rtlink = rtnav.GetElement
attach_name = attach_name + Chr(10) + rtlink.DisplayComment
Loop While rtnav.FindNextElement
If attach_name<>"" Then
.ActiveDocument.Tables.Item(1).Cell(i+1, 2).Range.InsertAfter doc.GetItemValue(result)(0) + Chr(10) + attach_name
Else
.ActiveDocument.Tables.Item(1).Cell(i+1, 2).Range.InsertAfter doc.GetItemValue(result)(0)
End If
.ActiveDocument.Tables.Item(1).Cell(i+1, 3).Range.InsertAfter doc.GetItemValue(status)(0)
With .ActiveDocument.Tables(1).Rows(i+1).Range
.Font.Size = 9
.Bold = False
End With
Next
.ActiveDocument.Content.InsertAfter vbCrLf
Set myRange = .ActiveDocument.Content
With myRange
.InsertParagraphAfter
.Collapse wdCollapseStart 'Collapse the range add paragraph
End With
myRange.Collapse wdCollapseEnd
.ActiveDocument.Tables.Add myRange, 2, 2
summ= "Summary of mould version:" + doc.GetItemValue( "summary" )(0)
Stop
attach_name=""
Set rtitem = doc.GetFirstItem("issues")
If ( rtitem.Type = RICHTEXT And Isarray(rtitem.EmbeddedObjects) ) Then
Forall o In rtitem.EmbeddedObjects
If ( o.Type = EMBED_ATTACHMENT ) Then
attach_name = attach_name + Chr(10) + o.name
End If
End Forall
End If
If attach_name<>"" Then
issue="Critical issues: " + doc.GetItemValue( "issues" )(0) + Chr(10) + attach_name
Else
issue="Critical issues: " + doc.GetItemValue( "issues" )(0)
End If
contr="Recommended extended process control: " + doc.GetItemValue( "control" )(0)
.ActiveDocument.Tables(2).Cell(1, 1).Range.InsertAfter summ
.ActiveDocument.Tables(2).Cell(1, 2).Range.InsertAfter issue
.ActiveDocument.Tables(2).Cell(2, 2).Range.InsertAfter contr
With .ActiveDocument.Tables(2).Range
.Font.Size = 9
.Bold = False
End With
With .ActiveDocument.Tables(2).Range
.Rows.Borders.Enable = True
.Columns.Borders.Enable = True
End With
.ActiveDocument.Tables(2).Columns(1).Cells.Merge
.ActiveDocument.Content.InsertAfter "*This information must follow all samples: Production date, Performed by, Articlename, Product group number, Mould version, Material(ID-name), Filler no., Shank no., Density, Curing time"
With .ActiveDocument.content
.Font.Size = 9
.Bold = False
End With
'.Visible = True
.ActiveDocument.PrintOut False
.ActiveDocument.Close wdDoNotSaveChanges
End With
objword1.quit
Set objword1 = Nothing
End Sub
Error appears on
Set rtlink = rtnav.GetElement
Thanks for any help