excel macro to get data from lotus notes 1

[curri23]

Hi TekTip bodies,
I need an excel macro (access will be accepted if no other choice available) to get different data from lotus notes text body and paste it into excel cells. I've looked hard searching through the Internet but it seems as is everybody is only interested in sending e-mails but not getting text data. Hope someone can help out here. Thanks in advance.

 

[curri23]

I forgot to mention. This is a CHALLENGE

 

[oholloway]

I also would like to know the answer to this question.

 

[bombtrk]

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