I’ve got some code that collects responses and generates an Excel spreadsheet. It works fine on around 20 or so documents, but any more and it seems to just hang up. Does anybody know if there’s a way of fixing this? Perhaps by processing the responses in batches of 20 perhaps? In some cases I will have 100 or so responses.
The code I use is below :
Option Public
Option Declare
Dim excel As Variant
Dim worksheet As Variant
Dim cell As Variant
Sub Initialize()
On Error Resume Next
Dim session As New NotesSession
Dim db As NotesDatabase
Dim doc As NotesDocument
Dim dcoll As NotesDocumentCollection
Dim responsedoc As notesdocument
Dim rowNum As Integer
Dim url As String
Dim defect As string
Set excel = OpenMSExcel(session)
Dim stmt As String
' Print out the header row
stmt = {Set worksheet = excel.Application.Workbooks(1).Sheets(1)}
If excel Is Nothing Then Print stmt Else Execute(stmt)
' Print out the first row
stmt = |Set worksheet = excel.Application.Workbooks(1).Sheets(1)
Set cell = worksheet.Range(“A1”)
cell.FormulaR1C1 = “Job Number”
Set cell = worksheet.Range(“B1”)
cell.FormulaR1C1 = “Job Description”
Set cell = worksheet.Range(“C1”)
cell.FormulaR1C1 = “Enter Quotations Here”
Set cell = worksheet.Range(“D1”)
cell.FormulaR1C1 = “Enter Comments Here”|
If excel Is Nothing Then Print stmt Else Execute(stmt)
rowNum = 2 ' Current row of data
' Get a NotesViewNavigator from our view
Set db = session.CurrentDatabase
Set doc = session.documentcontext
Set dcoll = doc.responses
Set responsedoc = dcoll.getfirstdocument
url = Left(Db.filepath,Len(db.filepath)-7) '7 is the length of RSS.nsf!
' Go through all the entries in the view
While Not responsedoc Is Nothing
If responsedoc.form(0) = "DDSE" Then
defect = Implode(responsedoc.DDSE_DefectDescription)
stmt = |Set cell = worksheet.Range("A| & CStr(rowNum) & |")
cell.FormulaR1C1 = "| & responsedoc.DDSE_JobNumber(0) & |"
Set cell = worksheet.Range("B| & CStr(rowNum) & |")
cell.FormulaR1C1 = "| & defect & |"|
If excel Is Nothing Then Print stmt Else Execute(stmt)
rowNum = rowNum + 1
End If
Set responsedoc = dcoll.getnextdocument(responsedoc)
Wend
rowNum = rowNum + 1
stmt = |Set cell = worksheet.Range("A| & CStr(rowNum) & |")
cell.FormulaR1C1 = "Time Quotation"
Set cell = worksheet.Range("B| & CStr(rowNum) & |")
cell.FormulaR1C1 = "Please enter number of days for repairs"|
If excel Is Nothing Then Print stmt Else Execute(stmt)
' Do some formatting
stmt = |worksheet.Rows("1:1").RowHeight = 25.5
Set cell = worksheet.Range(“A1:D1”)
cell.WrapText = True
cell.Font.FontStyle = “Bold”
worksheet.Columns(“A:A”).ColumnWidth = 25
worksheet.Columns(“B:B”).ColumnWidth = 45
worksheet.Columns(“C:C”).ColumnWidth = 30
worksheet.Columns(“D:D”).ColumnWidth = 50
Set cell = worksheet.Columns(“B:B”)
cell.WrapText = True
Set cell = worksheet.Columns(“C:C”)
cell.NumberFormat = “£#,##0”
Set cell = worksheet.Range(“C| & CStr(rowNum) & |”)
cell.NumberFormat = “0”
Set cell = worksheet.Columns(“D:D”)
cell.WrapText = True|
If excel Is Nothing Then Print stmt Else Execute(stmt)
If excel Is Nothing Then
Print {alert("Your Excel spreadsheet has been generated.")}
Print {history.go(-1)}
Print {</script>}
Else
excel.Visible = True
MsgBox "Your Excel spreadsheet has been generated.", 64, "Success"
End If
End Sub
Function OpenMSExcel(session As NotesSession) As Variant
' Open up a doc in Excel. If MS Excel is running, then create a new file in there. If it's
' not running, then it needs to be started.
Dim msExcel As Variant
If session.IsOnServer Then ' Web user
Print {<HTML>}
Print {<HEAD>}
Print {<script language='VBScript'>}
Print {Set excel = CreateObject("Excel.Application")}
Print {excel.Visible = True}
Print {Set newBook = excel.Workbooks.Add}
Set OpenMSExcel = Nothing
Else ' Notes client user
On Error GoTo CreateNewInstance
Set msExcel = GetObject("Excel.Application") ' Attempt to grab MS Excel if already open
Done:
msExcel.Visible = False
Call msExcel.Workbooks.Add
Set OpenMSExcel = msExcel
End If
Exit Function ' =====================
CreateNewInstance:
Print "Loading Microsoft Excel.... Please Wait...."
Err = 0 ' Clear the error handler
Set msExcel = CreateObject("Excel.Application") ' Launch MS Excel if not already open
Print " "
Resume Done ' Jump back up to the point where a document will be opened and returned
End Function