I am trying to update one of my reports. I want to add a ‘Comments’ column to display the comments from my database’s journal entries.
Would anyone be kind enough to tell me why this code gives me my new column but doesn’t bring in the comments that are in the Comments field? I am not getting any error messages, just no information.
Sub Initialize
Dim s As New NotesSession
Dim db As NotesDatabase
Dim totals() As Integer
Dim models() As String
Dim families () As String
Dim comment () As String
Dim reasons() As String
Dim treasons() As Integer
Dim rc As Integer
Set db = s.CurrentDatabase
'/ build the list of models to search for
Print "build list of models to search for"
newDbFilename = "Products.nsf"
Set pDB = s.GetDatabase( db.Server, Left(db.filepath,Instr(1,db.filepath,db.filename)-1)+newDbFilename )
Set pView = pDb.GetView("(Products_RM)")
Set pDoc = pView.GetFirstDocument
Dim modelnumbers() As String
Dim productfamilies() As String
p = 0
While Not pDoc Is Nothing
Redim Preserve modelnumbers(p)
Redim Preserve productfamilies(p)
modelnumbers(p) = pDoc.keymodelnumber(0)
productfamilies(p) = pDoc.productfamily(0)
p = p + 1
Set pDoc = pView.GetNextDocument(pDoc)
Wend
p = p -1
'/ search for total occurances of models
Print "search for the total occurances of each model"
For n = 0 To p
modelnumber = modelnumbers(n)
productfamily = productfamilies(n)
searchFormula$ = "FIELD modelnumber contains " & modelnumber
Set collection = db.FTSearch( searchFormula$, 0 )
Redim Preserve totals(n)
Redim Preserve models(n)
Redim Preserve families(n)
totals(n) = collection.count
models(n) = modelnumber
families(n) = productfamily
Next
'/ Sort the results (by totals column)
Print "Sort the results"
Lower = 0
Upper = p
For i = 1 To upper - lower
swapped = False
For k = lower To upper -1
If totals(k) < totals(k+1) Then
tmp = totals(k+1)
tmp2 = models(k+1)
totals(k+1) = totals(k)
models(k+1) = models(k)
totals(k) = tmp
models(k) = tmp2
swapped = True
End If
Next
If Not swapped Then Exit For
Next
Redim Preserve reasons(0)
Redim Preserve treasons(0)
Redim Preserve families(0)
Redim Preserve comment(0)
Print "Write the results"
'/ Write to Excel
Dim xlApp As Variant
Dim xlBook As Variant
Dim xlsheet As Variant
Dim xlWB As Variant
Set xlApp = CreateObject("excel.application")
Set xlWB = xlApp.Workbooks
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets(1)
xlSheet.Cells(2,2 ).Value = "CAREBase Report - Rubbermaid Calls Year-to-Date"
xlSheet.Cells(3,2).Value = "Calls"
xlSheet.Cells(3,3).Value = "Model"
xlSheet.Cells(3,4).Value = "Product Family"
xlSheet.Cells(3,5).Value = "Reason"
xlSheet.Cells(3,6).Value = "Comments"
rownum = 4
For j=0 To p
xlSheet.Cells(rownum, 2).Value = totals(j)
xlSheet.Cells(rownum, 3).Value = "'" & models(j)
'/ get reasons
rc = -1
searchFormula$ = "FIELD modelnumber contains " & models(j)
Set collection = db.FTSearch( searchFormula$, 0 )
Set rDoc = collection.GetFirstDocument
While Not rDoc Is Nothing
Forall r In rDoc.Reasons
foundAt = Arraygetindex( reasons(), r ,5 )
If Isnull(foundAt) Then
rc = rc + 1
Redim Preserve reasons(rc)
Redim Preserve treasons(rc)
Redim Preserve comment(rc)
comment(rc) = comments
reasons(rc) = r
treasons(rc) = 1
Else
treasons(foundAt) = treasons(foundAt) + 1
End If
End Forall
Set rDoc = collection.GetNextDocument(rDoc)
Wend
'/ Sort the results (by rtotals column)
Print "Sort the results"
Lower = 0
Upper = rc
For i = 1 To upper - lower
swapped = False
For k = lower To upper -1
If treasons(k) < treasons(k+1) Then
tmp = treasons(k+1)
tmp2 = reasons(k+1)
tmp3 = families(k+1)
tmp4 = comment(k+1)
treasons(k+1) = treasons(k)
reasons(k+1) = reasons(k)
families(k+1) = families(k)
comment(k+1) = comment(k)
treasons(k) = tmp
reasons(k) = tmp2
families(k) = tmp3
comment(k) = tmp4
swapped = True
End If
Next
If Not swapped Then Exit For
Next
'/ write reasons
For rb=0 To rc
rownum = rownum + 1
’ xlSheet.Cells(rownum, 4).Value = treasons(rb)
xlSheet.Cells(rownum, 4).Value = families(rb)
xlSheet.Cells(rownum, 5).Value = "'" & reasons(rb)
xlSheet.Cells(rownum, 6).Value = comment(rb)
Next
Redim reasons(0)
Redim treasons(0)
rownum = rownum + 1
Next
xlApp.Visible = True
Set xlSheet = Nothing
Set xlBook = Nothing
End Sub
Thanks!
Lori