Domino Code Fragment

Code Name*
OLE from Notes to Excel via LotusScript		Date*
07/04/2025		Source (or email address if you prefer)*
[email protected]
IP address:.108.162.241.91
Description*
Copies data from Notes to Excel using OLE automation		Type*
LotusScript		Categories*
(Misc)
Implementation:
Required Client:
Server:
Limitations:
Comments:
Files/Graphics attachments (if applicable): Code:

Here is some sample code.

Option Public
Option Declare

Dim Session As NotesSession
Dim WorkSpace As NotesUIWorkspace
Dim UIDoc As NotesUIDocument
Dim CurrentDB As NotesDatabase
Dim DataDB As NotesDatabase
Dim DataView As NotesView
Dim DataDoc As NotesDocument
Dim Currentdoc As NotesDocument
Dim RTItem As NotesRichTextItem
Dim IdView As NotesView
Dim IdKey As String
Dim xlApp As Variant
Dim FileName As String
Dim CellReference As Long
Dim Region As String
Dim Sales As Variant
Dim Units As Variant
Dim MSF As Variant
Dim GrandTotals As Variant
Dim RegionTotals As Variant
Dim SPTotals As Variant
Dim CustTotals As Variant
Dim I As Integer
Dim MonthCounter As Integer
Dim Rcounter As Integer
Dim CCounter As Integer
Dim xlSheet As Variant
Dim SP As String
Dim Cust As String
Dim AllMonths(1 To 12) As String
Dim MArray As Variant
Dim RC As Long
Dim NumOfMonths As Integer
Dim MSales As Double
Dim MUnits As Double
Dim MMSF As Double


Sub Initialize
Set Workspace = New NotesUIWorkspace
Set Session = New NotesSession
Set CurrentDB = Session.CurrentDatabase
Set IdView = CurrentDB.GetView("Ids")
Set UiDoc = Workspace.CurrentDocument
Set Currentdoc = UIDoc.Document
Dim RTItem As NotesRichTextItem
Dim Object As NotesEmbeddedObject
Set DataDb = session.GetDatabase( "WestCPD1", "Marketing\SPM.nsf" )
Set DataView = DataDB.GetView("Rpt1")
Set DataDoc = DataView.GetFirstDocument
If DataDoc Is Nothing Then
Messagebox("There is no data to report. Call Betsy Thiede x3088 to report a problem. Process Canceled.")
Exit Sub
End If
RCounter = 1
CCounter = 1
Select Case Month(Date)
Case Is < 11
NumOfMonths = Month(Date)+2
Case 11
NumofMonths = 1
Case Else
NumofMonths = 2
End Select
Call SetMonths()
Redim GrandTotals(1 To 3,1 To NumOfMonths) As Long
Redim RegionTotals(1 To 3,1 To NumOfMonths) As Long
Redim SPTotals(1 To 3,1 To NumOfMonths) As Long
Redim CustTotals(1 To 3,1 To NumOfMonths) As Long
Set xlApp = CreateObject("Excel.application")
xlApp.Visible = True
xlApp.Workbooks.Add
Set xlSheet = xlApp.Workbooks(1).Worksheets(1)

XLApp.Cells.Select
With XlApp.Selection
.Font.Name = "Arial"
.Font.Size = 8
End With
With xlSheet
'Writing the Headings
.Cells(RCounter, 2).Value = "Marketing Analysis Report sorted by Region, Salesperson and Customer"
XLApp.Rows(RCounter & ":" & RCounter).Select
XlApp.Selection.Font.Bold = True
RCounter = RCounter + 2
CCounter = CCounter + 1
For MonthCounter = 1 To NumOfMonths
.Cells(RCounter,CCounter).Value = MArray(MonthCounter)
CCounter = CCounter + 1
Next
.Cells(RCounter,CCounter).Value = "YTD"
CCounter = 1

End With
XLApp.Rows(RCounter & ":" & RCounter).Select
XlApp.Selection.Font.Bold = True
XLApp.Selection.HorizontalAlignment = -4108
'Set Flags
Region = DataDoc.Territory(0)
SP = DataDoc.SalesPerson(0)
Cust = DataDoc.CustName(0)
RCounter = RCounter + 1
With xlSheet
.Cells(RCounter,CCounter).Value = Region
RCounter = RCounter + 1
.Cells(RCounter,CCounter).Value = " " + SP
RCounter = RCounter + 1
.Cells(RCounter,CCounter).Value = " " + Cust
RCounter = RCounter + 1
End With
RC = 1
Do Until DataDoc Is Nothing
CCounter = 2
SP = DataDoc.SalesPerson(0)
Cust = DataDoc.CustName(0)
Do While Region = DataDoc.Territory(0)
Region = DataDoc.Territory(0)
Do While SP = DataDoc.SalesPerson(0)
SP = DataDoc.SalesPerson(0)
Do While Cust = DataDoc.CustName(0)
Cust = DataDoc.CustName(0)
Call CT()
Set DataDoc = DataView.GetNextDocument(DataDoc)
If DataDoc Is Nothing Then
Exit Do
End If
Loop
Call WriteCustInfo()
Call SPT
Redim CustTotals(1 To 3,1 To NumOfMonths) As Long
If DataDoc Is Nothing Then
Exit Do
End If
Cust = DataDoc.CustName(0)
RCounter = RCounter + 1
CCounter = 1
If Region <> DataDoc.Territory(0) Then
Else
If SP <> DataDoc.SalesPerson(0) Then
Else
With xlSheet
.Cells(RCounter,CCounter).Value = " " + Cust
End With
RCounter = RCounter + 1
End If
End If
Loop
Call WriteSPInfo()
Call RT()
Redim SPTotals(1 To 3,1 To NumOfMonths) As Long
If DataDoc Is Nothing Then
Exit Do
End If
SP = DataDoc.SalesPerson(0)
CCounter = 1
If Region <> DataDoc.Territory(0) Then
Else
With xlSheet
.Cells(RCounter,CCounter).Value = " " + SP
RCounter = RCounter + 1
.Cells(RCounter,CCounter).Value = " " + Cust
End With
RCounter = RCounter + 1
End If
Loop
Call WriteRInfo()
Call GT()
Redim RegionTotals(1 To 3,1 To NumOfMonths) As Long
RCounter = RCounter + 1
CCounter = 1
If DataDoc Is Nothing Then
Else
Region = DataDoc.Territory(0)
SP = DataDoc.SalesPerson(0)
Cust = DataDoc.CustName(0)
End If

If DataDoc Is Nothing Then
Exit Do
End If
With xlSheet
.Cells(RCounter,CCounter).Value = Region
RCounter = RCounter + 1
.Cells(RCounter,CCounter).Value = " " + SP
RCounter = RCounter + 1
.Cells(RCounter,CCounter).Value = " " + Cust
RCounter = RCounter + 1
End With
Loop
With xlSheet
CCounter = 1
RCounter = RCounter + 1
.Cells(RCounter,CCounter).Value = "Grand Total "
RCounter = RCounter + 1
.Cells(RCounter, CCounter).Value = "$ Sales"
CCounter = CCounter + 1
For MonthCounter = 1 To NumOfMonths
.Cells(RCounter,CCounter).Value = GrandTotals(1,MonthCounter)
CCounter = CCounter + 1
Next
.Cells(RCounter,CCounter).Value = "= Sum(R" & Trim(Cstr(RCounter)) & "C2 : " & "R" & Trim(Cstr(RCounter)) & "C" & Trim(Cstr(CCounter-1))
RCounter = RCounter + 1
CCounter = 1
.Cells(RCounter,CCounter).Value = "Units"
CCounter = CCounter + 1
For MonthCounter = 1 To NumOfMonths
.Cells(RCounter,CCounter).Value = GrandTotals(2,MonthCounter)
CCounter = CCounter + 1
Next
.Cells(RCounter,CCounter).Value = "= Sum(R" & Trim(Cstr(RCounter)) & "C2 : " & "R" & Trim(Cstr(RCounter)) & "C" & Trim(Cstr(CCounter-1))
RCounter = RCounter + 1
CCounter = 1
.Cells(RCounter,CCounter).Value = "MSF"
CCounter = CCounter + 1
For MonthCounter = 1 To NumOfMonths
.Cells(RCounter,CCounter).Value = GrandTotals(3,MonthCounter)
CCounter = CCounter + 1
Next
.Cells(RCounter,CCounter).Value = "= Sum(R" & Trim(Cstr(RCounter)) & "C2 : " & "R" & Trim(Cstr(RCounter)) & "C" & Trim(Cstr(CCounter-1))
RCounter = RCounter + 1
End With
Redim GrandTotals(1 To 3,1 To NumOfMonths) As Long
Call FormatRpt
On Error Resume Next
Kill "C:\Rpt1.xls"
Kill "C:\Rpt1.wk4"
On Error Goto 0

xlapp.activeworkbook.saveas "C:\rpt1.xls"
xlapp.activeworkbook.close
xlapp.quit
Set xlapp = Nothing

Set rtitem = New NotesRichTextItem(CurrentDoc, "FAttachment")
Set object = rtitem.embedobject(embed_attachment,"","C:\rpt1.xls","Summary Report")
Call CurrentDoc.Save(True,True)
Call Uidoc.Save
IdKey = CurrentDoc.UniversalId
Call uidoc.Close
Set CurrentDoc = IdView.GetDocumentByKey(IdKey)
Call workspace.EditDocument( True,CurrentDoc )
End Sub
Sub RT
For I = 1 To NumOfMonths
RegionTotals(1,I) = RegionTotals(1,I) + SPTotals(1,I)
RegionTotals(2,I) = RegionTotals(2,I) + SPTotals(2,I)
RegionTotals(3,I) = RegionTotals(3,I) + SPTotals(3,1)
Next
End Sub
Sub SPT
For I = 1 To NumOfMonths
SPTotals(1,I) = SPTotals(1,I) + CustTotals(1,I)
SPTotals(2,I) = SPTotals(2,I) + CustTotals(2,I)
SPTotals(3,I) = SPTotals(3,I) + CustTotals(3,I)
Next
End Sub
Sub CT
For I = 1 To NumOfMonths
Sales = DataDoc.GetItemValue("SLS" & Right("0" & Trim(Cstr(I)),2))
Units = DataDoc.GetItemValue("QTY" & Right("0" & Trim(Cstr(I)),2))
MSF = DataDoc.GetItemValue("MSF" & Right("0" & Trim(Cstr(I)),2))
MSales = Round(Sales(0)/1000,0)
MUnits = Round(Units(0)/1000,0)
MMSF = MSF(0)
CustTotals(1,I) = CustTotals(1,I) + MSales
CustTotals(2,I) = CustTotals(2,I) + MUnits
CustTotals(3,I) = CustTotals(3,I) + MMSF
Next
End Sub
Sub WriteCustInfo
With xlSheet
CCounter = 1
.Cells(RCounter, CCounter).Value = "$ Sales"
.Cells(RCounter,CCounter).HorizontalAlignment = -4152
CCounter = CCounter + 1
For MonthCounter = 1 To NumOfMonths
.Cells(RCounter,CCounter).Value = CustTotals(1,MonthCounter)
CCounter = CCounter + 1
Next
.Cells(RCounter,CCounter).Value = "= Sum(R" & Trim(Cstr(RCounter)) & "C2 : " & "R" & Trim(Cstr(RCounter)) & "C" & Trim(Cstr(CCounter-1))
CCounter = 1
RCounter = RCounter + 1
.Cells(RCounter,CCounter).Value = "Units"
.Cells(RCounter,CCounter).HorizontalAlignment = -4152
CCounter = CCounter + 1
For MonthCounter = 1 To NumOfMonths
.Cells(RCounter,CCounter).Value = CustTotals(2,MonthCounter)
CCounter = CCounter + 1
Next
.Cells(RCounter,CCounter).Value = "= Sum(R" & Trim(Cstr(RCounter)) & "C2 : " & "R" & Trim(Cstr(RCounter)) & "C" & Trim(Cstr(CCounter-1))
RCounter = RCounter + 1
CCounter = 1
.Cells(RCounter,CCounter).Value = "MSF"
.Cells(RCounter,CCounter).HorizontalAlignment = -4152
CCounter = CCounter + 1
For MonthCounter = 1 To NumOfMonths
.Cells(RCounter,CCounter).Value = CustTotals(3,MonthCounter)
CCounter = CCounter + 1
Next
.Cells(RCounter,CCounter).Value = "= Sum(R" & Trim(Cstr(RCounter)) & "C2 : " & "R" & Trim(Cstr(RCounter)) & "C" & Trim(Cstr(CCounter-1))
RCounter = RCounter + 1
End With
End Sub
Sub WriteSPInfo
With xlSheet
CCounter = 1
.Cells(RCounter,CCounter).Value = "Total for " + SP
RCounter = RCounter + 1
.Cells(RCounter, CCounter).Value = "$ Sales"
.Cells(RCounter,CCounter).HorizontalAlignment = -4152
CCounter = CCounter + 1
For MonthCounter = 1 To NumOfMonths
.Cells(RCounter,CCounter).Value = SPTotals(1,MonthCounter)
CCounter = CCounter + 1
Next
.Cells(RCounter,CCounter).Value = "= Sum(R" & Trim(Cstr(RCounter)) & "C2 : " & "R" & Trim(Cstr(RCounter)) & "C" & Trim(Cstr(CCounter-1))
RCounter = RCounter + 1
CCounter = 1
.Cells(RCounter,CCounter).Value = "Units"
.Cells(RCounter,CCounter).HorizontalAlignment = -4152
CCounter = CCounter + 1
For MonthCounter = 1 To NumOfMonths
.Cells(RCounter,CCounter).Value = SPTotals(2,MonthCounter)
CCounter = CCounter + 1
Next
.Cells(RCounter,CCounter).Value = "= Sum(R" & Trim(Cstr(RCounter)) & "C2 : " & "R" & Trim(Cstr(RCounter)) & "C" & Trim(Cstr(CCounter-1))
RCounter = RCounter + 1
CCounter = 1
.Cells(RCounter,CCounter).Value = "MSF"
.Cells(RCounter,CCounter).HorizontalAlignment = -4152
CCounter = CCounter + 1
For MonthCounter = 1 To NumOfMonths
.Cells(RCounter,CCounter).Value = SPTotals(3,MonthCounter)
CCounter = CCounter + 1
Next
.Cells(RCounter,CCounter).Value = "= Sum(R" & Trim(Cstr(RCounter)) & "C2 : " & "R" & Trim(Cstr(RCounter)) & "C" & Trim(Cstr(CCounter-1))
RCounter = RCounter + 2
End With
End Sub
Sub GT
For I = 1 To NumOfMonths
GrandTotals(1,I) = GrandTotals(1,I) + RegionTotals(1,I)
GrandTotals(2,I) = GrandTotals(2,I) + RegionTotals(2,I)
GrandTotals(3,I) = GrandTotals(3,I) + RegionTotals(3,I)
Next
End Sub
Sub SetMonths
AllMonths(1) = "Nov"
AllMonths(2) = "Dec"
AllMonths(3) = "Jan"
AllMonths(4) = "Feb"
AllMonths(5) = "Mar"
AllMonths(6) = "Apr"
AllMonths(7) = "May"
AllMonths(8) = "Jun"
AllMonths(9) = "Jul"
AllMonths(10) = "Aug"
AllMonths(11) = "Sep"
AllMonths(12) = "Oct"
Redim MArray(1 To NumOfMonths)
For MonthCounter = 1 To NumOfMonths
MArray(MonthCounter) = AllMonths(MonthCounter)
Next
End Sub
Sub WriteRInfo
With xlSheet
CCounter = 1
.Cells(RCounter,CCounter).Value = "Total for " + Region
RCounter = RCounter + 1
.Cells(RCounter, CCounter).Value = "$ Sales"
.Cells(RCounter,CCounter).HorizontalAlignment = -4152
CCounter = CCounter + 1
For MonthCounter = 1 To NumOfMonths
.Cells(RCounter,CCounter).Value = RegionTotals(1,MonthCounter)
CCounter = CCounter + 1
Next
.Cells(RCounter,CCounter).Value = "= Sum(R" & Trim(Cstr(RCounter)) & "C2 : " & "R" & Trim(Cstr(RCounter)) & "C" & Trim(Cstr(CCounter-1))
RCounter = RCounter + 1
CCounter = 1
.Cells(RCounter,CCounter).Value = "Units"
.Cells(RCounter,CCounter).HorizontalAlignment = -4152
CCounter = CCounter + 1
For MonthCounter = 1 To NumOfMonths
.Cells(RCounter,CCounter).Value = RegionTotals(2,MonthCounter)
CCounter = CCounter + 1
Next
.Cells(RCounter,CCounter).Value = "= Sum(R" & Trim(Cstr(RCounter)) & "C2 : " & "R" & Trim(Cstr(RCounter)) & "C" & Trim(Cstr(CCounter-1))
RCounter = RCounter + 1
CCounter = 1
.Cells(RCounter,CCounter).Value = "MSF"
.Cells(RCounter,CCounter).HorizontalAlignment = -4152
CCounter = CCounter + 1
For MonthCounter = 1 To NumOfMonths
.Cells(RCounter,CCounter).Value = RegionTotals(3,MonthCounter)
CCounter = CCounter + 1
Next
.Cells(RCounter,CCounter).Value = "= Sum(R" & Trim(Cstr(RCounter)) & "C2 : " & "R" & Trim(Cstr(RCounter)) & "C" & Trim(Cstr(CCounter-1))
RCounter = RCounter + 1
End With
End Sub
Sub FormatRpt
XlApp.Worksheets(1).pagesetup.orientation=2
Xlapp.Columns("B:P").Select
Xlapp.Selection.ColumnWidth = 7
Xlapp.Selection.NumberFormat = "#,##0"
Xlapp.columns("A").Select
XlApp.Selection.Columns.AutoFit
XlApp.Selection.Font.Bold = True
With XLApp.Worksheets(1)
.PageSetup.PrintTitleRows = "$1:$3"
.Pagesetup.RightFooter = "&8Page &P" & Chr$(13) & "Date: &D"
.Pagesetup.CenterFooter = ""
.Pagesetup.LeftMargin = XLApp.InchesToPoints(0.5)
.Pagesetup.RightMargin = XLApp.InchesToPoints(0.5)
.Pagesetup.TopMargin = XLApp.InchesToPoints(0.5)
.Pagesetup.BottomMargin = XLApp.InchesToPoints(1)
End With
End Sub