OK. I’ve looked at Sandbox/other searches on here/google/etc…
I need to export a Rich Text field (and other fields) to Word.
I have some code that does everythig except export the Rich Text field.
Current problems:
-
It just takes the RichText item from the first document (I expect I can solve this by adding a deselect all command);
-
If theres a picture (e.g. screenshot), in the RTF, in word, it gives you a horrible grey image of the picture, rather than the nice, normal, colourful picture shown in the RTF.
-
Using this method requires me to use uidoc class, and open/edit every single document. This is very slow, and it doesn’t seem to close each document as I asked it to…
Is there not a back-end way to export ‘whatever is in the Rich Text field’ into Word Document…
Cannot buy Midas Rich Text or similar.
Have looked at all examples on Sandbox…(none of them include Rich Text)…
Or shall I just give up and just say, you can only have the text that is in there, and nothing else (GetUnFormatted Text).
This is development code, so apologies, but here goes:
Sub Initialize
'These declarations are required - later they are set as the word application and current word doc
Dim word1 As Variant
Dim word As Variant
Dim wordoc As Variant
Dim session As New NotesSession
Dim db As NotesDatabase
Dim dc As NotesDocumentCollection
Dim view As NotesView
Dim vc As NotesViewEntryCollection
Dim entry As NotesViewEntry
Dim doc As NotesDocument
Dim uidoc As NotesUIDocument
Dim ws As New NotesUIWorkspace
Set db = session.CurrentDatabase
If (db Is Nothing) Then Goto endofsub
Set view = db.GetView("8. Export\With detailed description")
Set vc = view.AllEntries
Dim x As Integer
Dim cp As Integer ' used to count the offset position of the columns
x=1 ' used to count the number of the selected document
cp=0
Set word1 = CreateObject("Word.Application") 'Create Word object
Call word1.Quit
Set word = CreateObject("Word.Application") 'Create Word object
Call word.documents.Add()'Create a new document based on the template "Normal.dot"
Set worddoc = word.activedocument 'Get a handle for the active document
word.visible = True
Dim Country As String
Const wdItem = 16
Const wdCell = 12
Const wdFormatDocument = 0
Const wdGoToTable = 2
Const wdInsertCellsEntireRow = 2
Const wdInsertCellsShiftDown =1
Const wdLine =5
Const wdCharacter = 1
Const wdPasteRTF =1
'Need these declares - originally these were in Visual Basic re-written into LotusScript
Dim oTable As Variant
Dim oRow As Variant
Dim oCell As Variant
Dim Counter As Long
Dim NumRows As Long
Dim TextInRow As Boolean
For x = 1 To vc.Count
Set entry = vc.GetNthEntry(x)
Set doc = entry.Document
Dim Eval1 As Variant
Eval1 = Evaluate(|@DbLookup("" ;""; "Keywords";"Export Title 3";2)|)
Dim EvalRef As Variant
EvalRef = doc.Change_num
CRnum = Cstr(Eval1(0)) + ": " + Cstr(EvalRef(0))
Dim Eval3 As Variant
Eval3 = Evaluate(|@DbLookup("" ;""; "Keywords";"Export Title 1";2)|)
Dim EvalCountry As Variant
EvalCountry = doc.Region
'Dim Country As String
Country = Cstr(Eval3(0)) + ": " + Cstr(EvalCountry(0))
Dim Eval4 As Variant
Eval4 = Evaluate(|@DbLookup("" ;""; "Keywords";"Export Title 2";2)|)
Dim Business As String
EvalBusiness = doc.User_Group
Business = Cstr(Eval4(0)) + ": " + Cstr(EvalBusiness(0))
Dim Eval5 As Variant
Eval5 = Evaluate(|@DbLookup("" ;""; "Keywords";"Export Title 4";2)|)
Dim ReqDes As String
EvalReqDes = doc.Change_Desc
ReqDes = Cstr(Eval5(0)) + ": " + Cstr(EvalReqDes(0))
'Dim DetailedDes As String
'EvalDetailedDes = doc.Change_Desc_1
'ReqDes = Cstr(Eval6(0)) + ": " + Cstr(EvalReqDes(0))
Dim rtitem As NotesRichTextItem
Set rtitem = doc.GetFirstItem( "Change_Desc_1" )
Dim DetailedDes As String
If rtitem Is Nothing Then
DetailedDes=" "
Else
Dim DetailedDes1 As String
DetailedDes1 = rtitem.GetUnformattedText()
Dim Eval6 As Variant
Eval6 = Evaluate(|@DbLookup("" ;""; "Keywords";"Export Title 5";2)|)
DetailedDes = Cstr(Eval6(0)) + ": " + DetailedDes1
End If
'Dim rtitem1 As NotesRichTextItem
'Set rtitem1 = doc.GetFirstItem( "design_system_changes" )
'Dim rtitem2 As NotesRichTextItem
'Dim SolutionDes As String
'If rtitem1 Is Nothing Then
'SolutionDes=" "
'Else
'Dim SolutionDes1 As String
'SolutionDes1 = rtitem1.GetUnformattedText()
'Dim Eval7 As Variant
'Eval7 = Evaluate(|@DbLookup("" ;""; "Keywords";"Export Title 6";2)|)
'SolutionDes = Cstr(Eval6(0)) + ": " + rtitem1
'SolutionDes = rtitem1.GetFirstItem
'End If
'Set uidoc = doc.Uidocument
'Call ws.EditDocument(False, doc)
Call ws.EditDocument(True, doc)
Set uidoc = ws.CurrentDocument
'Call.uidoc.Edit
Call uidoc.GotoField("design_system_changes")
If design_system_Changes <>"" Then
Call uidoc.SelectAll
Call uidoc.Copy
Call uidoc.Close(True)
End If
'Messagebox "userName.Country",, "Country" + Cstr(Country)
cp=0 ' reset the column position
'Forall columns In entry.ColumnValues
With Word.Selection
.TypeText(CRnum)
.TypeParagraph
.TypeText (Country)
'.MoveDown wdLine
.TypeParagraph
.TypeText(Business)
.TypeParagraph
.TypeText(ReqDes)
.TypeParagraph
.TypeText(DetailedDes)
.TypeParagraph
.TypeParagraph
'.TypeText(rtitem1)
'.wdPasteRTF (rtitem1)
.PasteAndFormat (wdPasteDefault)
.TypeParagraph
.TypeParagraph
End With
cp= cp + 1
'End Forall
Next
'Do Nothing
endofsub:
’ place any wrap up stuff here
End Sub