Export Rich Text Field data from Notes Document to HTML File

Export Rich Text Field data from Notes Document to HTML File

 The requirement is to pull data from a rich text field called Activity History from Lotus Notes Document to Text or HTML File. One HTML file will be created for each Document.


Option Public
Option Declare

Dim db As NotesDatabase
Dim GSLdb As NotesDatabase
Dim GSLview As NotesView
Dim dc As NotesDocumentCollection
Dim doc As NotesDocument
Dim docRecord As NotesDocument
Dim docEmail As NotesDocument
Dim x As Integer
Dim fileNum As Integer
Dim fileName As String
Dim CustName As String
Dim CustID As String
Dim AHUnformattedText As String
Dim strFilePathSource As String
Dim item As NotesItem
Dim rtitem As NotesRichTextItem
Dim rtBodyItem As NotesRichTextItem


Sub Initialize

Dim session As New NotesSession
Set db = session.CurrentDatabase
Set GSLdb = session.Getdatabase("HAWDEV/RSP-Dev", "CC0436_TEST.nsf")
Set GSLview = GSLdb.Getview("By Customer")
Set docRecord = GSLview.GetFirstDocument
While Not (docRecord Is Nothing)
If docRecord.Hasitem("ActivityHistory") Then
Set item = docRecord.GetFirstItem("ActivityHistory")
x% = item.Type
If X% = "1" Then
Set rtitem = docRecord.GetFirstItem("ActivityHistory")
AHUnformattedText = rtitem.GetFormattedText(False, 0)
Call ReplaceSubstring(AHUnformattedText, Chr(13), "<BR>")
CustName = docRecord.CUSTOMERNAME(0)
CustID = docRecord.CUSTOMERID(0)

fileNum% = FreeFile()
fileName$ = "E:\Temp\"+CustID+"_"+Format(docRecord.Created, "Medium Date")+".html"
'You can use the TXT to HTML as a File to get the data saved.
            'fileName$ = "E:\Temp\"+CustID+"_"+Format(docRecord.Created, "Medium Date")+".txt"
Open fileName$ For Output As fileNum
Write #fileNum%, AHUnformattedText
Close fileNum%
End If
End If
Set docRecord = GSLview.GetNextDocument(docRecord)
AHUnformattedText = ""
Wend

'-----------------------------------------------------------------------------------------------------------------------------------------------
' Notify CC Admin with attached processed time report
'-----------------------------------------------------------------------------------------------------------------------------------------------

Set docEmail = db.CreateDocument

With docEmail
.Form = "memo"
.Subject = "CC Activity creation to Specified folder is completed"
.SendTo = "gvr11@live.com"
End With

Set rtBodyItem = docEmail.CreateRichTextItem("Body")

With rtBodyItem
Call .AppendText ("Hello,")
Call .AddNewLine(2)
Call .AppendText("CC Activity creation to Specified folder is completed")
Call .AddNewLine(2)
Call .AppendText("Thank you,")
Call .AddNewLine(1)
Call .AppendText ("CC Administrator")
End With

'Send email
docEmail.Send True
End Sub
-----------------------------------------------------------------------------------------------
Function ReplaceSubstring (Text As String, find As String, repl As String) As Integer ' "replace" cannot be used - change to "repl"
Const PROCNAME = "ReplaceSubstring"

Dim intReturn As Integer
intReturn = True 'Generic error condition

On Error GoTo errHandler

Dim pos As Long 'Integer - will overflow on large files
pos = InStr(Text, find)

Do While (pos > 0)
Text = Left$(Text, pos - 1) & repl & Mid$(Text, pos + Len(find))
pos = InStr(pos + Len(repl), Text, find)
Loop

intReturn = False 'No Error
GoTo endFunc

errHandler:
On Error Resume Next
intReturn = Err
Resume endFunc

endFunc:
ReplaceSubstring = intReturn
End Function

----------------------------------------------------------------------------------------------------------------
The requirement is to pull data from a rich text field called Activity History from Lotus Notes Document to Text or HTML File. One HTML or CSV file will be created for All Documents.


Option Public
Option Declare

Dim db As NotesDatabase
Dim GSLdb As NotesDatabase
Dim GSLview As NotesView
Dim dc As NotesDocumentCollection
Dim doc As NotesDocument
Dim docRecord As NotesDocument
Dim docEmail As NotesDocument
Dim x As Integer
Dim fileNum As Integer
Dim fileName As String
Dim CustName As String
Dim CustID As String
Dim CustDispCom As String
Dim AHUnformattedText As String
Dim strFilePathSource As String
Dim item As NotesItem
Dim rtitem As NotesRichTextItem
Dim rtBodyItem As NotesRichTextItem

Sub Initialize

Dim session As New NotesSession
Set db = session.CurrentDatabase
Set GSLdb = session.Getdatabase("ISQD02/SLHC-Dev", "Developers\Venu\us0418_TEST.nsf")
Set GSLview = GSLdb.Getview("By Customer")

fileNum% = FreeFile()
fileName$ = "E:\Temp\Credit Collections Activity History.csv"
'fileName$ = "E:\Temp\Credit Collections Activity History.html"
Open fileName$ For Output As fileNum
'Write #fileNum%, "<meta http-equiv=","Content-Type"," content=","text/html;charset=ISO-8859-1",">"
Set docRecord = GSLview.GetFirstDocument
While Not (docRecord Is Nothing)
If docRecord.Hasitem("ActivityHistory") Then
Set item = docRecord.GetFirstItem("ActivityHistory")
x% = item.Type
If X% = "1" Then
Set rtitem = docRecord.GetFirstItem("ActivityHistory")
AHUnformattedText = rtitem.GetFormattedText(False, 0)
'Call ReplaceSubstring(AHUnformattedText, Chr(13), "<BR>")
Call ReplaceSubstring(AHUnformattedText, Chr(13), " ")
Call ReplaceSubstring(AHUnformattedText, Chr(10), " ")
Call ReplaceSubstring(AHUnformattedText, Chr(9), " ")
Call ReplaceSubstring(AHUnformattedText, """", " ")
CustName = docRecord.CUSTOMERNAME(0)
CustID = docRecord.CUSTOMERID(0)
CustDispCom = docRecord.CustomerDisputeComment(0)
' Write #fileNum%, "<table border=",1," style=width:100%>","<tr><td>"
' Write #fileNum%, "<h4>", CustID,"-", CustName,"</h4>" ,"<BR>"
Write #fileNum%, CustID,"-", CustName
Write #fileNum%, "Dispute Comments - ",CustDispCom
Write #fileNum%, "ActivityHistory - ",AHUnformattedText
Write #fileNum%, "-----------------------------------------------------------------------------------------"
' Write #fileNum%, "</td></tr></table>"
End If
End If
Set docRecord = GSLview.GetNextDocument(docRecord)
AHUnformattedText = ""
CustDispCom = ""
Wend
Close fileNum%

'-----------------------------------------------------------------------------------------------------------------------------------------------
' Notify CC Admin with attached processed time report
'-----------------------------------------------------------------------------------------------------------------------------------------------

Set docEmail = db.CreateDocument

With docEmail
.Form = "memo"
.Subject = "CC Activity creation to Specified folder is completed"
.SendTo = "vreddy@osi-systems.com"
End With

Set rtBodyItem = docEmail.CreateRichTextItem("Body")

With rtBodyItem
Call .AppendText ("Hello,")
Call .AddNewLine(2)
Call .AppendText("CC Activity creation to Specified folder is completed")
Call .AddNewLine(2)
Call .AppendText("Thank you,")
Call .AddNewLine(1)
Call .AppendText ("CC Administrator")
End With

'Send email
docEmail.Send True
End Sub
-----------------------------------------------------------------------------------------------
Function ReplaceSubstring (Text As String, find As String, repl As String) As Integer ' "replace" cannot be used - change to "repl"
Const PROCNAME = "ReplaceSubstring"

Dim intReturn As Integer
intReturn = True 'Generic error condition

On Error GoTo errHandler

Dim pos As Long 'Integer - will overflow on large files
pos = InStr(Text, find)

Do While (pos > 0)
Text = Left$(Text, pos - 1) & repl & Mid$(Text, pos + Len(find))
pos = InStr(pos + Len(repl), Text, find)
Loop

intReturn = False 'No Error
GoTo endFunc

errHandler:
On Error Resume Next
intReturn = Err
' nLog.LogError Err, "[" & PROCNAME & " " & Erl & "] " & Error
Resume endFunc

endFunc:
ReplaceSubstring = intReturn

End Function

-----------------------------------------------------------------------------------------------