Excel Export

hcl-bot · March 21, 2012, 11:04am

I am trying to use an excel template that is stored in a notes document to do an export. If I had the excel file in a directory on the user’s computer I would use the following code:

Dim xlApp As Variant

	Dim xlSheet As Variant

	

	Set xlApp = CreateObject("Excel.Application")

	xlApp.StatusBar = "Creating WorkSheet. Please be patient..."

	xlApp.Visible = True

	xlApp.Workbooks.Add("c:\Template.xls")

	xlApp.ReferenceStyle = 2

	Set xlsheet = xlApp.Workbooks(1).Worksheets(1)

	xlsheet.Name = "PRISM"

	xlApp.StatusBar = "Exporting Data. Please be patient."

I don’t want to store the file on the users computer, I want to access it from the notesdocument and do the same code for the import. I use the following code to access the excel object in the notes document:

Dim view As NotesView

Set view=db.GetView("Template")

Dim tdoc As NotesDocument

Set tdoc=view.GetDocumentByKey("attach",True)

Dim rtitem As NotesRichTextItem

Set rtitem=tdoc.GetFirstItem("Body")

Dim object As NotesEmbeddedObject

Set object=rtitem.EmbeddedObjects(0)

I can’t figure out a way to set my xlApp in the previous code to use the object. Any help?

hcl-bot · March 21, 2012, 1:04pm

Subject: afaik

as far as I know you’ll need to detach the spreadsheet from the notes document to a temp directory on the client pc, then you can continue as you used to.after use, you can kill the temporary file.

hcl-bot · March 21, 2012, 1:39pm

Subject: I’ve done that

I already have that code written but I don’t want to do it this way because the users have different file structures depending on their OS.

hcl-bot · March 26, 2012, 10:27am

Subject: script for excel

Todd,

this code is using a template from a notes document,

Dim ProgressBar As NotesUIDocument

Dim strText1,strText2, strPath1, strPath2, strExecApp As String

Dim intCnt, intMax As Integer

Sub Initialize

Dim session As New NotesSession

Dim Ws As New NotesUiWorkspace

Dim db As NotesDatabase

Dim view As NotesView

Dim entry As NotesViewEntry

Dim allentries As NotesViewEntryCollection

Dim doc As NotesDocument  , newdoc As NotesDocument, newMtdoc As NotesDocument

Dim maildoc As NotesDocument

Dim rtitem As NotesRichTextItem

Dim eobj As NotesEmbeddedObject

Dim range As Variant 

Dim TheCellCounter As Integer  

Dim workbooks As Variant  

Dim numrecs As Double

Dim MonthObj As New NotesDateTime("") 

MonthObj.LSLocalTime = Now



Dim xlApp As Variant			'* Used to create Excel Object

Dim strNetDrive As String	'* Used to determine the Network dirve letter

Dim strLocalDrv As String	'* Used to determine the Local dirve letter

Dim strReport As String		'* Used to Store Report Type

'*

 '** Determine Local Drive Mapping 

 '*

strNetDrive = Curdrive$()                                        '* Get Current dirve the user is using 

strLocalDrv   = "C:"                                                '* Set Default Drive Mapping

If strNetDrive = "U:" Then                                      '* If User is on MetaFrame

	strLocalDrv = "V:"                                             '* Then use MetaFrame local drive mapping

End If                                                                     '* Endif

'*

 '** Define File Path of  Export SpreadSheet

 '*

strReport	= "Monthly"			'* Define Report Type

strPath1 	= strLocalDrv & "\RM"	'* Define Drive and Main Root Directory path

strPath2 	= "Reports"			'* Define Sub-Directory

strExecApp= "Clients comptant (mois) EN"		'* Define Name of Excel Application

'*

'** Open Progress Bar Window and Setup Excel Application

'*

Set db = session.CurrentDatabase

Set newdoc = New NotesDocument( db )



	Set xlApp = CreateObject("Excel.application")

	xlApp.Workbooks.Open(strPath1 & "\" & strPath2 & "\" & strExecApp & ".xls")

	xlApp.Visible = True

’ set my stuff

	Set db = session.CurrentDatabase

'	Set view = db.getView("vwByCompany") 

	Set view = db.getView("vwByCashMultivalue") 

	Set allentries = view.AllEntries

	Set entry = allentries.GetFirstEntry

’ See if there are any doc to process

	If entry Is Nothing Then

		Print("There is no data available to create the Report.") 

		Exit Sub

	End If

	Set doc = entry.Document

	Set newdoc = New NotesDocument( db )

	

	……. 

	numrecs = 0 

	

	xlApp.range("A8:C8").Select

	xlApp.Selection.Merge

'	xlApp.range("A8").value = Format$(MonthObj.LSLocalTime,"mmmm") & ", " & Year(Now) 

	Dim PositionOfChar As Variant

	PositionOfChar = Instr(SalesmanSelected,"-")

	xlApp.range("A8").value = MonthSelected  & " " & Year(Now) & "  " & Mid( SalesmanSelected, PositionOfChar )

’ merge the cells for the second title

	With xlApp.Selection

		HorizontalAlignment = xlCenter

		VerticalAlignment = xlBottom

		WrapText = False

		Orientation = 0

		AddIndent = False

		IndentLevel = 0

		ShrinkToFit = False

		ReadingOrder = xlContext

		MergeCells = False

	End With

’ xlApp.Selection.Merge

'TheCellCounter = 8

	TheCellCounter = 11

	

	While Not ( entry Is Nothing )

		Set doc = entry.Document

		If doc Is Nothing Then

			Print("There is no data available") 

			Exit Sub

		Else   

			Stop

			If doc.dlSalesman(0) = Left$(SalesmanSelected, 2) Then

				TheCellCounter = TheCellCounter + 1    

				numrecs = numrecs + 1

		''''

	' Columns 1-10   

				ClientNo = doc.ClientCashNumber(0)

				

				xlApp.range("A" & TheCellCounter).value = ClientNo 'doc.ClientAmNumber(0)

				xlApp.range("B" & TheCellCounter).value = doc.txtClientNumber(0)

				xlApp.range("C" & TheCellCounter).value = doc.txtCompany(0)

				xlApp.range("D" & TheCellCounter).value = ""' doc.dlSalesman(0)

						' Verify that the number is not empty

				Dim Answer As Variant

				Answer = 0

				Select Case MonthSelected			

				Case "January"      

				…..

				End Select

'Now autofit the spreadsheet for ease of reading

'start reporting from A6 to N + theCellCounter

				Range_1 = "A12"    

				Range_2 = "C" & TheCellCounter     

				Range_3 = "D" & TheCellCounter  

				Range_4 = "E" & TheCellCounter

				Range_5 = "F" & TheCellCounter   

				Range_6 = "G" & TheCellCounter

				Range_7 = "H" & TheCellCounter

	'	xlApp.range(Range_1, Range_6). Select

'get the next record

				Total1 = Total1 + Total

				Total2 = Total2 + Answer

			End If

		End If

		Set entry = allentries.GetNextEntry(entry)

'fit the width of the individual columns so that column titles are automatically seen

'	xlApp.Selection.Columns.Autofit

		

		

	Wend 

	

	xlApp.range("D" & TheCellCounter+1).Font.Bold = True

	xlApp.range("D" & TheCellCounter+1).Font.ColorIndex = 1

	xlApp.range("D" & TheCellCounter+1).value = "TOTAL"

	xlApp.range("E" & TheCellCounter+1).Font.Bold = True

	xlApp.range("E" & TheCellCounter+1).Font.ColorIndex = 1

	xlApp.range("E" & TheCellCounter+1).value = Total1 

	xlApp.range("F" & TheCellCounter+1).Font.Bold = True

	xlApp.range("F" & TheCellCounter+1).Font.ColorIndex = 1

	xlApp.range("F" & TheCellCounter +1).value = Total2

	xlApp.Sheets("Sheet1").Select

	xlApp.Sheets("Sheet1").Name = "Liste des clients Comptant"

’ Visible notification that the agent has finished runing

	Print "End of daily reporting extract.  Number of documents extracted =",numrecs

	

End If

’ error trap

end_process:

Print "Error has occured in line number:",Erl

Exit Sub

Resume



Call ProgressScreen(ProgressBar,"End","","","","")

End Sub

Sub Export()

Dim Session As New NotesSession

Dim docExcel As NotesDocument

Dim dbCurrent As NotesDatabase

Dim Rtitem As Variant                               'Used to extract Excel SpreadSheet 

Dim Object As NotesEmbeddedObject     'Used to extract Excel SpreadSheet 

Dim viewPMOExport As NotesView



Const ErrPathFileAccessError       = 75

 '*

'** Find Excel Application to extract

'*

Set dbCurrent             =  Session.CurrentDatabase									'* Get Database Object

Set viewPMOExport   = dbCurrent.GetView("ETExports")							'* Get View that contains Excel Attachements

Set docExcel              = viewPMOExport.GetFirstDocument						'* Get Document with Excel Attachments

Set Rtitem                  = docExcel .GetFirstItem("ETExports")					'* Get RichText Field containing Attachments

Set Object                  = Rtitem.GetEmbeddedObject(strExecApp & ".xls")		'* Get Attachement Object to Extract



On Error ErrPathFileAccessError Resume Next



strText2 = "Looking for => " & strPath1 & "\" & strPath2 & " <= Directory"

intCnt = intCnt + 1



If Dir$(strPath1,ATTR_DIRECTORY) = "" Then

	Mkdir strPath1	

	Mkdir strPath1 & "\" & strPath2

Elseif Dir$(strPath1 & "\" & strPath2,ATTR_DIRECTORY) = ""  Then

	Mkdir strPath1 & "\" & strPath2

End If



strText2 =  "Detaching " & strExecApp & ".xls"

intCnt = intCnt + 1

Call Object.ExtractFile(strPath1 & "\" & strPath2 & "\" & strExecApp & ".xls")

End Sub

Function CreateDataWithExcel

' Visible notification that the agent has started to run 

Print "Begin daily reporting extract."

’ Error trap

On Error Goto end_process

’ Dim my stuff

Dim session As New NotesSession

Dim Ws As New NotesUiWorkspace

Dim db As NotesDatabase

Dim view As NotesView

Dim entry As NotesViewEntry

Dim allentries As NotesViewEntryCollection

Dim doc As NotesDocument, newdoc As NotesDocument

Dim maildoc As NotesDocument

Dim rtitem As NotesRichTextItem

Dim eobj As NotesEmbeddedObject

Dim range As Variant 

Dim TheCellCounter As Integer  

Dim workbooks As Variant  

Dim numrecs As Double

Dim MonthObj As New NotesDateTime("") 

MonthObj.LSLocalTime = Now

’ set my stuff

Set db = session.CurrentDatabase

Set view = db.getView("vwByCompanyE")

Set allentries = view.AllEntries

Set entry = allentries.GetFirstEntry

’ See if there are any doc to process

If entry Is Nothing Then

	Print("There is no data available to create the Report.") 

	Exit Function

End If

Set doc = entry.Document

Set newdoc = New NotesDocument( db )



' get the users to send to

'Answer = Ws.DialogBox("ReportsNamesProcess",True, True, False, False, False, False,"Reports Process.", newdoc)

'If Answer Then

'get todays time. I will use this as part of the filename

TheTime = Evaluate("@ReplaceSubstring(@Subset(@Subset(@Explode(@Text(@Now)); 2); -1); "":""; ""_"")", doc)

'get todays date. I will use this as part of the filename

TheDate = Evaluate("@ReplaceSubstring(@Text(@Today); ""/""; ""_"")", doc)

'create a unique filename. In this case a spot on a shared drive

TheFileName = newdoc.ReportPath(0)

’ counter for the number of records that are processed

numrecs = 0

'Create an instance of Excel

Set object = createobject("excel.application")

'Add a workbook

object.workbooks.add

’ Make Excel visible to the user

object.visible = False

’ headers for first page

object.range("A7").value = "bbbb"

object.range("A7").Font.Bold = True

object.range("A7").Font.ColorIndex = 5 



object.range("B7").value = "# ccc"

object.range("B7").Font.Bold = True

object.range("B7").Font.ColorIndex = 5



object.range("C7").value = "Adredddsse"

object.range("C7").Font.Bold = True

object.range("C7").Font.ColorIndex = 5  



object.range("D7").value = "eeee"

object.range("D7").Font.Bold = True

object.range("D7").Font.ColorIndex = 5  



object.range("E7").value = "ffff."

object.range("E7").Font.Bold = True

object.range("E7").Font.ColorIndex = 5  



object.range("F7").value = "ggg"

object.range("F7").Font.Bold = True

object.range("F7").Font.ColorIndex = 5

’ add 2 more columns…

object.range("A8").value = "mmmmmmmm"

object.range("A8").Font.Bold = True

object.range("A8").Font.ColorIndex = 1



object.range("A8:I8").Select

’ merge the cells for the second title

With object.Selection

	HorizontalAlignment = xlCenter

	VerticalAlignment = xlBottom

	WrapText = False

	Orientation = 0

	AddIndent = False

	IndentLevel = 0

	ShrinkToFit = False

	ReadingOrder = xlContext

	MergeCells = False

End With

object.Selection.Merge



TheCellCounter = 8



While Not ( entry Is Nothing )

	TheCellCounter = TheCellCounter + 1    

	Set doc = entry.Document

	If doc Is Nothing Then

		Print("There is no data available") 

		Exit Function

	Else   

		numrecs = numrecs + 1

		''''

’ Columns 1-10

		object.range("A" & TheCellCounter).value = numrecs

		object.range("B" & TheCellCounter).value = doc.txtClientNumber(0)

		object.range("C" & TheCellCounter).value = doc.txtCompany(0)

		object.range("D" & TheCellCounter).value = doc.txtFirstName(0) + " " + doc.txtLastName(0)

		object.range("E" & TheCellCounter).value = doc.txtPhone(0)

		object.range("F" & TheCellCounter).value = doc.dlSalesman(0)

	End If

'Now autofit the spreadsheet for ease of reading

'start reporting from A6 to N + theCellCounter

	Range_1 = "A7"    

	Range_2 = "C" & TheCellCounter     

	Range_3 = "D" & TheCellCounter  

	Range_4 = "E" & TheCellCounter

	Range_5 = "F" & TheCellCounter   

	Range_6 = "G" & TheCellCounter

	

	object.range(Range_1, Range_6). Select

'get the next record

	Set entry = allentries.GetNextEntry(entry)

'fit the width of the individual columns so that column titles are automatically seen

	object.Selection.Columns.Autofit

Wend 

''''

’ fit the width of the individual columns so that column titles are automatically seen

TheRange = "A8" + ":" + Range_6

object.Worksheets("Sheet1").Range(TheRange).Columns.AutoFit

'Create a worksheet title

TheTitle = "Submission Progress Report" & Chr(10) & "          " & Day(Now) & " " & Format$(MonthObj.LSLocalTime,"mmmm") & " " & Year(Now)

'Assign a name to the data’s worksheet

object.Sheets("Sheet1").Select

object.Sheets("Sheet1").Name = "cccccccccccccc"

'Align, and create the dimensions of the title box

object.ActiveSheet.TextBoxes.Add(20, 20, 235, 50).Select

object.Selection.Left = 220.75

object.Selection.Top = 11.25

object.Selection.Interior.ColorIndex = 2

object.Selection.Characters.Text = TheTitle

'Format the font

object.Selection.Font.Bold =True

object.Selection.Font.Size = 16

object.Selection.Orientation = xlHorizontal

'Select a cell so the current text box isn’t highlighted

object.range("A6").Select

’ save the spreadsheet

	' find out if the dir exsist.

temdir = "C:\PPb Reports\"

If Dir$(temdir, 16) ="" Then

	Mkdir "C:\PPb Reports\"

End If 

object.ActiveWorkbook.SaveAs(TheFileName)

’ quit excel

object.Quit

‘ Visible notification that the agent has finished runing

Print "End of daily reporting extract.  Number of documents extracted =",numrecs

Exit Function

’ error trap

end_process:

Print "Error has occured in line number:",Erl

Print "Error code:",Str(Err),Error$ & " OR Error may be caused because the C:\DRA Reports\ Directory has not been created yet."

Exit Function

Resume

Sub Export()

Dim Session As New NotesSession

Dim docExcel As NotesDocument

Dim dbCurrent As NotesDatabase

Dim Rtitem As Variant                               

Dim Object As NotesEmbeddedObject     

Dim viewPMOExport As NotesView



Const ErrPathFileAccessError       = 75

Set dbCurrent             =  Session.CurrentDatabase									'* Get Database Object

Set viewPMOExport   = dbCurrent.GetView("ETExports")							'* Get View that contains Excel Attachements

Set docExcel              = viewPMOExport.GetFirstDocument						

Set Rtitem                  = docExcel .GetFirstItem("ETExports")					

Set Object                  = Rtitem.GetEmbeddedObject(strExecApp & ".xls")	



On Error ErrPathFileAccessError Resume Next



strText2 = "Looking for => " & strPath1 & "\" & strPath2 & " <= Directory"

intCnt = intCnt + 1

If Dir$(strPath1,ATTR_DIRECTORY) = "" Then

	Mkdir strPath1	

	Mkdir strPath1 & "\" & strPath2

Elseif Dir$(strPath1 & "\" & strPath2,ATTR_DIRECTORY) = ""  Then

	Mkdir strPath1 & "\" & strPath2

End If



strText2 =  "Detaching " & strExecApp & ".xls"

intCnt = intCnt + 1

Call Object.ExtractFile(strPath1 & "\" & strPath2 & "\" & strExecApp & ".xls")

End Sub

hcl-bot · January 7, 2014, 4:44pm

Subject: script for excel

Hi, do you know a way to ask for a value of an excel cell using lotus scripts?