Try this out...
Sub Initialize
On Error Resume Next
Dim dbSession As New NotesSession
Dim db As NotesDatabase
Dim curView As NotesView
Dim StatDoc As NotesDocument
Dim ExcelPath As String
Dim ExcelFileName As String
Dim MSAction As String
Dim path As String
Dim oExcel As Variant
Dim oWorkbook As Variant
Dim openExcel As Integer
'connect to the current opened Database
Set db = dbSession.CurrentDatabase
'set the current view, filename and refresh
Set curView = db.GetView ( "All")
DefaultFileName$="c:\All"+".xls"
Call curView.Refresh
If curView Is Nothing Then
Messagebox "View does not exist"
End
End If
'get the first document in the view and check for an empty view
Set StatDoc = curView.GetFirstDocument
If StatDoc Is Nothing Then
Messagebox "Current View is empty."
End
End If
Set oExcel = CreateObject ( "Excel.Application" )
ExcelPath = DefaultPath$
path = oExcel.Path
oExcel.Quit
Set oExcel = Nothing
Call ExportToExcel ( ExcelPath, DefaultFileName$, curView)
If Instr ( ExcelFileName, " " ) > 0 Then
DefaultFileName$ = {"} & DefaultFileName$ & {"}
End If
openExcel = Shell ( path & "\excel.exe " &DefaultFileName$, 3 )
exit_sub:
If Not oExcel Is Nothing Then
oExcel.Quit
Set oExcel = Nothing
End If
Exit Sub
End Sub
Sub ExportToExcel ( ExcelPath As String, ExcelFileName As String, curView As NotesView)
Dim curDoc As NotesDocument
Dim oExcel As Variant
Dim oWorkbook As Variant
Dim oWorkSheet As Variant
Dim i As Double
On Error Resume Next
'Automate Excel, add a workbook and a worksheet
'Set oExcel = CreateObject ( "Excel.Application" )
Set oExcel = CreateObject("Excel.Application")
'Set oWorkbook = oExcel.Workbooks.Add(1)
'Set oWorkSheet= oWorkbook.Sheets ( 1 )
Set oWorkbook = oExcel.Workbooks.Open("C:\All.xls")
If Err Then
Msgbox "here"
Set oWorkbook = oExcel.Workbooks.Add(1)
oWorkbook.SaveAs ( "C:\All.xls" )
End If
Set oWorkSheet= oWorkbook.Sheets ( "Sheet1" )
'Set oWorksheet = oWorkbook.Worksheets(1)
'oExcel.Cells(1, 1).Value = 11
'oWorkbook.WorkSheets(1).Range("A1").Value = "TEST"
'oWorkSheet.Range("A1").Value = "AAAA"
'oExcel.Visible = True
oWorkSheet.Cells.Select
oWorkSheet.Range("A1:M10000").ClearContents
'End
'Start reading information in the view. If view is empty, then quit
Set curDoc = curView.GetFirstDocument
If curDoc Is Nothing Goto exit_sub
'This section adds headings in row 2
oWorkSheet.Range("A1").Value = "Requested by"
oWorkSheet.Range("B1").Value = "Analyst"
oWorkSheet.Range("C1").Value = "Date Created"
oWorkSheet.Range("D1").Value = "Est. Start Date"
oWorkSheet.Range("E1").Value = "Act Start Date"
oWorkSheet.Range("F1").Value = "Est. Complete Date"
oWorkSheet.Range("G1").Value = "Actual Complete Date"
oWorkSheet.Range("H1").Value = "Category"
oWorkSheet.Range("I1").Value = "Department"
oWorkSheet.Range("J1").Value = "Summary"
oWorkSheet.Range("K1").Value = "Request Title"
oWorkSheet.Range("L1").Value = "Comments"
oWorkSheet.Range("M1").Value = "Status"
oWorkSheet.Range("N1").Value = "Priority"
oWorkSheet.Range("O1").Value = "Work Weeks"
oWorkSheet.Range("P1").Value = "Process Name"
oWorkSheet.Range("Q1").Value = "Process Owner"
oWorkSheet.Range("R1").Value = "User Priority"
oWorkSheet.Range("S1").Value = "Management Sponsor"
oWorkSheet.Range("T1").Value = "Team / Resources"
oWorkSheet.Range("U1").Value = "Root Cause"
oWorkSheet.Range("V1").Value = "Proposed Solution"
oWorkSheet.Range("W1").Value = "Alternatives"
oWorkSheet.Range("X1").Value = "Target Implementation Date"
oWorkSheet.Range("Y1").Value = "Estimated Costs (out of pocket)"
oWorkSheet.Range("Z1").Value = "Estimated Costs (internal)"
oWorkSheet.Range("AA1").Value = "Business Benefits"
oWorkSheet.Range("AB1").Value = "Post Implementation KPIs"
'The first row that will contain view data is 2
i = 2
Do Until curDoc Is Nothing
'This section adds the view information to excel
oWorkSheet.Range ( "A" & i ).Value = curDoc.txtCreator(0)
oWorkSheet.Range ( "B" & i ).Value = curDoc.cmbAnalyst(0)
oWorkSheet.Range ( "C" & i ).Value = curDoc.dtDateCreated(0)
oWorkSheet.Range ( "D" & i ).Value = curDoc.dtEstStartDate(0)
oWorkSheet.Range ( "E" & i ).Value = curDoc.dtActStartDate(0)
oWorkSheet.Range ( "F" & i ).Value = curDoc.dtEstCompDate(0)
oWorkSheet.Range ( "G" & i ).Value = curDoc.dtActCompDate(0)
oWorkSheet.Range ( "H" & i ).Value = curDoc.dlCategory(0)
oWorkSheet.Range ( "I" & i ).Value = curDoc.dlDepartment(0)
oWorkSheet.Range ( "J" & i ).Value = curDoc.rtBRAB(0)
oWorkSheet.Range ( "K" & i ).Value = curDoc.txtRequestTitle(0)
oWorkSheet.Range ( "L" & i ).Value = curDoc.rtComments(0)
oWorkSheet.Range ( "M" & i ).Value = curDoc.txtOCStatus(0)
oWorkSheet.Range("N" & i).Value = curDoc.txtPriority(0)
oWorkSheet.Range("O" & i).Value = curDoc.txtEstWorkWeek(0)
oWorkSheet.Range("P" & i).Value = curDoc.txtProcessName(0)
oWorkSheet.Range("Q" & i).Value = curDoc.txtProcessOwner(0)
oWorkSheet.Range("R" & i).Value = curDoc.cmbUserPriority(0)
oWorkSheet.Range("S" & i).Value = curDoc.txtSponsor(0)
oWorkSheet.Range("T" & i).Value = curDoc.txtTeamResources(0)
oWorkSheet.Range("U" & i).Value = curDoc.txtRootCause(0)
oWorkSheet.Range("V" & i).Value = curDoc.txtProposedSolution(0)
oWorkSheet.Range("W" & i).Value = curDoc.txtAlternatives(0)
oWorkSheet.Range("X" & i).Value = curDoc.dtTargetImpDate(0)
oWorkSheet.Range("Y" & i).Value = curDoc.txtOutOfPocket(0)
oWorkSheet.Range("Z" & i).Value = curDoc.txtInternal(0)
oWorkSheet.Range("AA" & i).Value = curDoc.txtEstBenefits(0)
oWorkSheet.Range("AB" & i).Value = curDoc.txtPostImpKPIs(0)
'Increment to the next row
i = i + 1
'Increment to the next document
Set curDoc = curView.GetNextDocument ( curDoc )
Loop
Exit_Sub:
'Take our objects out of memory, save file, and quit excel
Set oWorkSheet= Nothing
oWorkbook.Save
Set oWorkbook = Nothing
oExcel.Quit
Set oExcel = Nothing
End Sub
