Hi,
I have the code below that exports information from documents to an excel spreadsheet. The most relevant information is in the rich text fields that get exported. It worked fine up to now, now it seems to go out of sync, it places some other client’s rich text info in another client’s rich text field.
Maybe you see something I don’t, but can’t get my head around why it doesn’t work one day, but it did before. I tried export a few on their own, and the information is correct.
****** Code ***********
Dim xlApp As Variant
Dim xlSheet As Variant
Dim x As Integer
Sub excelExport
Dim s As New NotesSession
Dim db As NotesDatabase
Dim coll As NotesDocumentCollection
Dim fieldHeader As String
Dim fieldHeaderVar As Variant
Dim sF As String
Set db = s.CurrentDatabase
fieldHeader = "Client Name^Client Code^Job Code^Product Code(s)^Job Partner^Job Manager^Administrator^Related Entity Text^Attachment Y/N"
fieldHeaderVar = Split(fieldHeader, "^")
setUpWorkBook
setupHeading db, fieldHeaderVar
sF = "Form = 'MasterDoc'"
Set coll = db.Search(sF, Nothing, 0)
outputReport db, coll
xlApp.Visible = True 'Shows the Excel application started in the background.
End Sub
Sub setUpWorkBook
Set xlApp = CreateObject("Excel.application")
xlApp.Workbooks.Add
Set xlSheet = xlApp.Workbooks(1).Worksheets(1)
With xlSheet.PageSetup
.Orientation = 1 ' Portrait
.PaperSize = 9 ' A4
.Zoom = False
.FitToPagesTall = False
.FitToPagesWide = 1 ' This line and the above force data to fit on one page.
.CenterHorizontally = 1 'Center-aligns content on page
.PrintTitleRows = "$3:$3" 'Set the third row to be the header row - sets the row to print at top of each page
End With
End Sub
Sub setupHeading(db As NotesDatabase, fieldHeaderVar As Variant)
x = 1
'Set up column headings
For i = 1 To (Ubound(fieldHeaderVar) + 1)
xlSheet.Cells(x, i).Value = fieldHeaderVar(i - 1)
xlSheet.Cells(x, i).Font.Bold = True
xlSheet.Columns(i).Columnwidth = Len(fieldHeaderVar(i - 1)) + 2
Next
End Sub
Sub outputReport(db As NotesDatabase, coll As NotesDocumentCollection)
Dim doc As NotesDocument
Dim docCount As Integer
Dim collCount As Integer
Dim rti As NotesRichTextItem
Dim txtOly As String
Dim nam As NotesName
Dim namList As String
Set doc = coll.GetFirstDocument
x = x + 1
collCount = coll.Count
While Not doc Is Nothing
namList = ""
docCount = docCount + 1
Print "Processing doc " & Cstr(docCount) & " of " & Cstr(collCount)
horzCount = 1
xlSheet.Cells(x, 1).Value = doc.ClientName(0)
xlSheet.Cells(x, 2).Value = "'"&doc.ClientCode(0)
xlSheet.Cells(x, 3).Value = Join(doc.JobCode,", ")
xlSheet.Cells(x, 4).Value = Join(doc.TowCode,", ")
Forall v In doc.BillPartnerName
Set nam = New NotesName(Cstr(v))
If namList = "" Then
namList = nam.Common
Else
namList = namList + ", " + nam.Common
End If
End Forall
xlSheet.Cells(x, 5).Value = namList
namList = ""
Forall v In doc.BillManagerName
Set nam = New NotesName(Cstr(v))
If namList = "" Then
namList = nam.Common
Else
namList = namList + ", " + nam.Common
End If
End Forall
xlSheet.Cells(x, 6).Value = namList
namList = ""
Forall v In doc.Administrators
Set nam = New NotesName(Cstr(v))
If namList = "" Then
namList = nam.Common
Else
namList = namList + ", " + nam.Common
End If
End Forall
xlSheet.Cells(x, 7).Value = namList
Set rti = doc.GetFirstItem("RelatedEntities")
On Error Goto TooLarge
txtOnly = rti.GetFormattedText(False,0)
If txtOnly = "" Then
xlSheet.Cells(x, 8).Value = " - No Text - "
Else
xlSheet.Cells(x, 8).Value = txtOnly
End If
If doc.HasEmbedded Then
xlSheet.Cells(x, 9).Value = "Y"
Else
xlSheet.Cells(x, 9).Value = "N"
End If
x = x + 1
Set doc=coll.GetNextDocument(doc)
Wend
TooLarge:
xlSheet.Cells(x, 8).Value = " - Too Large To Export - "
Resume Next
End Sub