Sunday, September 20, 2009

Creating Word Document from Notes

Here is the code to export to word:

Function exportDataToWord(lsCITRDescTitle As String, lsFileName As String, loUDoc As NotesDocument) As Integer
'%REM
On Error Goto ErrorHandlerFunc

Dim wordObj, wdocs, wRange As Variant
Set wordObj = CreateObject("Word.Application")
Set wdocs = wordObj.Documents.Add(lsFileName)
wdocs.Activate
'wdocs.

Set wRange = wdocs.Bookmarks("wCITR_CreationDt").Range
Dim dateTime As New NotesDateTime(Cstr(loUDoc.CITR_CreationDt(0)))
lsEffDt$ = dateTime.DateOnly
wRange.InsertBefore lsEffDt$

Set wRange = wdocs.Bookmarks("wCITR_SNDANo").Range
wRange.InsertBefore Cstr(loUDoc.CITR_SNDANo(0))

Set wRange = wdocs.Bookmarks("wCITR_Number").Range
wRange.InsertBefore Cstr(loUDoc.CITR_Number(0))

lvConxDiscInfo = Evaluate(|@Implode(CITR_ConxDisc; @Char(13))|, loUDoc)
lsConxDiscInfo$ = Trim$(Cstr(lvConxDiscInfo(0)))
Set wRange = wdocs.Bookmarks("wCITR_ConxDisc").Range
wRange.InsertBefore lsConxDiscInfo$

lvOtherDiscInfo = Evaluate(|@Implode(CITR_OtherDisc; @Char(13))|, loUDoc)
lsOtherDiscInfo$ = Trim$(Cstr(lvOtherDiscInfo(0)))
Set wRange = wdocs.Bookmarks("wCITR_OtherDisc").Range
wRange.InsertBefore lsOtherDiscInfo$

Dim z As Integer
Dim lvCITRPurposes As Variant
Dim lsSetOtherReason As String
If (lsCITRDescTitle = "First Version") Then
Set wRange = wdocs.Bookmarks("wCITR_PurposeOfDisc").Range
wRange.InsertBefore Cstr(loUDoc.CITR_PurposeOfDisc(0))

lvContainOther = Evaluate(|@Contains(CITR_PurposeOfDisc; "Other")|, loUDoc)
lsContainOther$ = Trim(Cstr(lvContainOther(0)))
If (lsContainOther$ = "True" Or lsContainOther$ = "true" Or lsContainOther$ = "1") Then
lvCITR_OtherReasons = Evaluate(|@Implode(CITR_OtherReasons; @Char(13))|, loUDoc)
lsCITR_OtherReasons$ = Trim$(Cstr(lvCITR_OtherReasons(0)))
Set wRange = wdocs.Bookmarks("wCITR_OtherReasons").Range
wRange.InsertBefore lsCITR_OtherReasons$
End If
Else
lsCap1$ = Trim(Cstr(wDocs.chkA.Caption))
lsCap2$ = Trim(Cstr(wDocs.chkB.Caption))
lsCap3$ = Trim(Cstr(wDocs.chkC.Caption))
lsCap4$ = Trim(Cstr(wDocs.chkD.Caption))
lsCap5$ = Trim(Cstr(wDocs.chkE.Caption))
lvCITRPurposes = loUdoc.GetItemValue("CITR_PurposeOfDisc")
For z = 0 To Ubound(lvCITRPurposes)

If (Trim(Cstr(lvCITRPurposes(z))) = lsCap1$) Then
wDocs.chkA.value = True
Elseif (Trim(Cstr(lvCITRPurposes(z))) = lsCap2$) Then
wDocs.chkB.value = True
Elseif (Trim(Cstr(lvCITRPurposes(z))) = lsCap3$) Then
wDocs.chkC.value = True
Elseif (Trim(Cstr(lvCITRPurposes(z))) = lsCap4$) Then
wDocs.chkD.value = True
Elseif (Trim(Cstr(lvCITRPurposes(z))) = lsCap5$) Then
wDocs.chkE.value = True
End If

If (Trim(Cstr(lvCITRPurposes(z))) = "Other") Then
lsSetOtherReason = "1"
End If

Next

If (lsSetOtherReason = "1") Then
lvCITR_OtherReasons = Evaluate(|@Implode(CITR_OtherReasons; @Char(13))|, loUDoc)
lsCITR_OtherReasons$ = Trim$(Cstr(lvCITR_OtherReasons(0)))
wdocs.txtbxA.value = lsCITR_OtherReasons$
End If
End If
lvCITR_Address = Evaluate(|@Implode(CITR_Address; @Char(13))|, loUDoc)
lsCITR_Address$ = Trim$(Cstr(lvCITR_Address(0)))
Set wRange = wdocs.Bookmarks("wCITR_Address").Range
wRange.InsertBefore lsCITR_Address$

Set wRange = wdocs.Bookmarks("wCITR_Address1").Range
wRange.InsertBefore Cstr(loUDoc.CITR_Address1(0))

Set wRange = wdocs.Bookmarks("wCITR_OtherCompName").Range
wRange.InsertBefore Cstr(loUDoc.CITR_OtherCompName(0))

Set wRange = wdocs.Bookmarks("wCITR_City").Range
wRange.InsertBefore Cstr(loUDoc.CITR_City(0))

Set wRange = wdocs.Bookmarks("wCITR_StateCountry").Range
wRange.InsertBefore Cstr(loUDoc.CITR_StateCountry(0))

Set wRange = wdocs.Bookmarks("wCITR_Zip").Range
wRange.InsertBefore Cstr(loUDoc.CITR_Zip(0))

Set wRange = wdocs.Bookmarks("wCITR_Representor").Range
wRange.InsertBefore Cstr(loUDoc.CITR_Representor(0))

Set wRange = wdocs.Bookmarks("wCITR_Signer").Range
wRange.InsertBefore Cstr(loUDoc.CITR_Signer(0))

Set wRange = wdocs.Bookmarks("wCITR_Desig").Range
wRange.InsertBefore Cstr(loUDoc.CITR_Desig(0))

Set wRange = wdocs.Bookmarks("wCITR_Title").Range
wRange.InsertBefore Cstr(loUDoc.CITR_Title(0))

wdocs.SaveAs lsFileName$
wdocs.Close
wordObj.Application.Quit

lsPathOfWord$ = "C:\Program Files\Microsoft Office\Office\WINWORD.EXE " & Cstr(lsFileName)
taskId% = Shell(lsPathOfWord$, 1)

exportDataToWord = True

Exit Function

ErrorHandlerFunc:
Print "Error Msg : " & Error$() & " at line no. of Function : " & Erl()
Resume Next
'%END REM
End Function

No comments:

Post a Comment

Search This Blog