Hi,I have built a lotus script code in an agent which will provide me an excel sheet that contains all mails from my sentbox which are only replied(not forwarded).
I have used a dialogue box to get the start date and end date from the end user who will pull the report.
When i pull the report for today’s date(current date) the code is working fine, but when i pull any date i.e…,past dates like yesterday or day before yesterday i am getting an error object variable not set in the while loop for any particular document.
Please find my code below:
Option Public
Option Declare
Sub Initialize
On Error GoTo ErrorHandler
Dim Nws As New NotesUIWorkspace
Dim ss As New NotesSession
Dim db As NotesDatabase
Dim vw As NotesView
Dim resVw As NotesView
Dim doc As NotesDocument
Dim respDoc As NotesDocument
Dim tempDoc As NotesDocument
Dim docColl As NotesDocumentCollection
Dim parUNID As String
Dim nm As NotesName
Dim oExcelApp As Variant
Dim oExcelBook As Variant
Dim oExcelSheet As Variant
Dim vtFileName As Variant
Dim sSourceName As String
Dim iRowCount As Integer
Dim iColCount As Integer
Dim strdat As String
Dim enddat As String
Dim vdat As Variant
Dim edat As Variant
Dim toList As String
Dim nmCommon As String
Dim cnt As Integer
Dim ccList As String
Set db = ss.Currentdatabase
Set tempDoc = New NotesDocument ( db )
'dat = InputBox("Enter date in dd/mmm/yyyy format. ex: 17/OCT/2011","Export by Date")
Call Nws.Dialogbox("fmDatePicker", True, True, False, False, False, False, "Select Date", tempDoc)
strdat = tempDoc.fldStartDate(0)
enddat = tempDoc.fldEndDate(0)
If strdat = "" Then
MessageBox "No Start Date entered. Quiting Export", 48,"Export Functionality"
Exit Sub
End If
If enddat = "" Then
MessageBox "No End Date entered. Quiting Export", 48,"Export Functionality"
Exit Sub
End If
If tempDoc.fldEndDate(0) - tempDoc.fldStartDate(0) < 0 Then
MessageBox "End date should be on or after Start Date. Quiting Export", 48,"Export Functionality"
Exit Sub
End If
If tempDoc.fldEndDate(0) > Today Or tempDoc.fldStartDate(0) > Today Then
MessageBox "Either start date or end date is later than today's date.Please check.Quiting Export", 48, "Export Functionality"
Exit Sub
End If
' If Not IsDate(strdat) Then
' MessageBox "Please Enter Valid date value", 48,"Export By Date"
' Exit Sub
' End If
Set vw = db.getview("($InboxExport)")
Set resVw = db.getView("($SentExport)")
If vw Is Nothing Then
MessageBox "View ($InboxExport) is not available.Please check.Quiting Export", 48, "Export Functionality"
Exit Sub
End If
vDat = DateValue(strdat)
eDat = DateValue(enddat)
Set oExcelApp = CreateObject("Excel.Application")
If ( oExcelApp Is Nothing ) Then
MessageBox "Could not create Excel Object." + Chr(10) + _
"Make sure Excel is installed on this computer.", 16, _
"Creation of Excel Object Failed"
Exit Sub
End If
'Open new Excel work book
oExcelApp.DisplayAlerts = False
Set oExcelBook = oExcelApp.Workbooks.Add
'Get sheet
Set oExcelSheet = oExcelBook.ActiveSheet
'Write Column Headers to Excel Sheet
With oExcelSheet
'\\ Export View
.Cells(4, 1).value = "Received From"
.Cells(4, 2).value = "Received Date"
.Cells(4, 3).value = "Subject"
.Cells(4, 4).value = "Action on Mail" '--> Add this column in header, comment to Nataraj
.cells(4, 5).value = "Actioned Date"
.cells(4, 6).value = "Actioned By"
.cells(4, 7).value = "Recepients Sent To"
.cells(4, 8).value = "Recepients CC To"
' End If
End With
'Bold titles
oExcelSheet.Range("4:4").Font.Bold = True
'Set Date format
'Initialise row count
iRowCount = 5
While vDat <= eDat
Print "start exporting sent mails on date -> " & Str(vDat)
Set docColl = vw.Getalldocumentsbykey(vDat, True)
Set doc = docColl.Getfirstdocument()
While ( Not doc Is Nothing )
With oExcelSheet
iColCount = 1
'To export Recepient Name '---> Add Multiple people, comment to Nataraj
If doc.Hasitem("$RespondedTo") Then
Set respDoc = resVw.Getdocumentbykey(doc.Universalid,True)
'get hold of response document.
If respDoc.Form(0) = "Reply" Then
iRowCount = iRowCount +1
'First Column --> 'Who sent'
If respDoc.hasitem("Principal") Then
Set nm = New NotesName(doc.Principal(0))
Else
Set nm = New NotesName(doc.From(0))
End If
.Cells(iRowCount, iColCount) = nm.common
iColCount = iColCount + 1
'Second Column --> 'Date/Time Arrived'
.Cells(iRowCount, iColCount) = doc.DeliveredDate(0)
iColCount = iColCount + 1
'Third Column --> 'Subject'
.Cells(iRowCount, iColCount) = doc.Subject(0)
iColCount = iColCount + 1
'Fourth Column → ‘Action on Mail’
.Cells(iRowCount, iColCount) = "Replied"
iColCount = iColCount + 1
'fifth column -> Actioned Date
.Cells(iRowCount, iColCount) = respDoc.PostedDate(0)
iColCount = iColCount + 1
'sixth Column -> Actioned by
Set nm = New NotesName(respDoc.From(0))
.Cells(iRowCount, iColCount) = nm.Common
iColCount = iColCount + 1
'Seventh Column -> Recepients Sent to
cnt=0
toList=""
If respDoc.HasItem("SendTo") Then
ForAll st1 In respDoc.SendTo
If Len(toList )=0 Then
Set nm = New NotesName(respDoc.SendTo(0))
nmCommon=nm.Common
toList=nmCommon
Else
cnt=cnt+1
Set nm = New NotesName(respDoc.SendTo(cnt))
nmCommon=nm.Common
toList=toList+","+nmCommon
End If
End ForAll
End If
.Cells(iRowCount, iColCount) = nmCommon
iColCount = iColCount + 1
'Eighth Column -> Recepients in CC
cnt=0
ccList=""
If respDoc.HasItem("CopyTo") Then
ForAll st1 In respDoc.CopyTo
If Len(ccList )=0 Then
Set nm = New NotesName(respDoc.CopyTo(0))
nmCommon=nm.Common
ccList=nmCommon
Else
cnt=cnt+1
Set nm = New NotesName(respDoc.CopyTo(cnt))
nmCommon=nm.Common
ccList=ccList+","+nmCommon
End If
End ForAll
End If
.Cells(iRowCount, iColCount) = ccList
iColCount = iColCount + 1
End If
End If
End With
Set respDoc = Nothing
Set doc = docColl.GetNextDocument( doc )
Wend
vDat = vDat + 1
Set docColl = Nothing
Set doc = Nothing
Wend
'Auto fit column widths
oExcelSheet.Columns.AutoFit
'Write heading here (after auto fit)
With oExcelSheet
.Range("1:1").Font.Size = 14
.Cells(1, 1).value = "Excel Report on Mails sent from " + strdat + " to " + enddat+ " - Report Generated on " + _
Format$(Now, "dd mmm yyyy hh:mm")
oExcelSheet.Range("2:2").Font.Italic = True
' End If
End With
'Save Excel File and close up shop
If ( iRowCount > 5 ) Then
'Write Total Count
If( iRowCount = 6 ) Then
oExcelSheet.Cells( iRowCount + 2, 1).value = "1 document matched export criteria"
Else
oExcelSheet.Cells(iRowCount + 2, 1).value = CStr(iRowCount- 5 ) + _
" documents matched export criteria"
End If
'Prompt for Excel file location
vtFileName = Nws.SaveFileDialog(False, "Choose New File", "Microsoft Excel|*.xls", "c:\windows\desktop")
If ( IsScalar(vtFileName) ) Then
oExcelApp.Quit
MessageBox "Export cancelled at your request.", 48, "Excel Export"
Exit Sub
End If
'Save Excel File
Call oExcelBook.SaveAs( vtFileName(0) )
oExcelBook.Title = "Notes Data Export from " & sSourceName
Call oExcelBook.Save
Call oExcelBook.Close
MessageBox "Excel Report will be saved on the specified location",0,"Excel Report"
oExcelApp.Quit
'If( MessageBox("Excel Report will be saved on your desktop") = 6 ) Then
'
' oExcelApp.DisplayAlerts = True
' Set oExcelBook = oExcelApp.Workbooks.Open( vtFileName(0) )
' Set oExcelSheet = oExcelBook.ActiveSheet
'
' oExcelApp.Visible = True
'
'Else
' oExcelApp.Quit
'End If
Else
Call oExcelBook.Close
oExcelApp.Quit
MessageBox "No documents found (matching export criteria). Confirm if you are entering Correct Date timeperiod", 48, "Excel Export"
End If
errorend:
Exit Sub
ErrorHandler:
MessageBox "Error while exporting on line:" & Erl & " and error is " & Str(Err) & ":" & Error$ & " and With doc:" & doc.Subject(0)
Resume errorend
End Sub