Import Excel files directly into new Notes documents (v2)

Drop this code into a view action button or agent. It will automatically create the fields based on the first row values of the XLS file. The only configurable variable that needs to be set is the desired form name for the new records. THIS ONLY DIFFERENCE IS THIS CODE FROM VERSION 1 IS THAT IT WILL STRIP OUT ANY/ALL SPACES FROM THE FIELDNAMES AUTOMATICALLY.
LotusScript

This function will allow you to import data directly from Excel spreadsheets into Notes. The desired fieldnames must be provided in the first row and can not start out with numbers or symbols.

	'The value of this variable determines what the "form" field will be set to upon import.
	Dim formname As String
	'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
	formname = "Compliance"
	'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
		
	Dim workspace As New NotesUIWorkspace
	Dim session As New NotesSession
	Dim db As NotesDatabase
	Set db = session.CurrentDatabase
	
	'New doc variables
	Dim doc As NotesDocument	
	Dim f As Integer
	
	'Variable of selection of file
	Dim tmpFile As Variant
	Dim sFilename As String
	
	'Excel file variables
	Dim xlsApp As Variant			' Application Excel
	Dim xlsWorkBook As Variant	' Sorter
	Dim xlsSheet As Variant			' Worksheet
	Dim xlsLine As Integer			' Line
	Dim xlsColumn As Integer		' Column
	
	'Prompt the user to select the Excel file to import
	tmpFile = workspace.OpenFileDialog(False, "Excel File to Open", "Excel Files | *.xls", "C:")	
	sFilename = tmpFile(0)
	If sFilename = "" Then Exit Sub
	
	'Table variables
	Dim sLineArray() As String
	Dim sColumnArray() As String
	
	'Counter variables
	Dim iCounter As Integer
	Dim iLineCounter As Integer
	Dim iColumnCounter As Integer
	
	'Validation Flag
	Dim ValidationFlag As Variant
	
	'Open the Excel file
	Print "Connecting to Excel..."
	Set xlsApp = CreateObject("Excel.Application")				' Create an instance
	Print "Opening the file : " & sFilename
	xlsApp.Workbooks.Open sFilename							' Open the file
	Set xlsWorkBook = xlsApp.ActiveWorkbook				' Get the current workbook
	Set xlsSheet = xlsWorkBook.ActiveSheet					' Get the active sheet
	xlsApp.Visible = False												' Hide the OLE session
	xlsSheet.Cells.SpecialCells(11).Activate						' This asks Excel to return a range of only cells with data
	xlsLine = xlsApp.ActiveWindow.ActiveCell.Row				' Number lines to treat
	xlsColumn = xlsApp.ActiveWindow.ActiveCell.Column		' Number columns to treat
	
	'Retrieve the fieldnames from the column headers
	xlsSheet.Cells(1, 1).Select
	For iColumnCounter = 1 To xlsColumn
		If iColumnCounter = 1 Then
			Redim sColumnArray(iColumnCounter) As String
			sColumnArray(iColumnCounter) = replaceSubString(xlsSheet.Cells(1, iColumnCounter).Value, " ", "")
		Else
			Redim Preserve sColumnArray(iColumnCounter) As String
			sColumnArray(iColumnCounter) = replaceSubString(xlsSheet.Cells(1, iColumnCounter).Value, " ", "")
		End If
	Next
	
	'Retrieve the values of the cells of each line
	For iLineCounter = 2 To xlsLine
		xlsSheet.Cells(iLineCounter, 1).select
		For iColumnCounter = 1 To xlsColumn
			If iColumnCounter = 1 Then
				'reset the array for the first value
				Redim sLineArray(iColumnCounter) As String
				sLineArray(iColumnCounter) = xlsSheet.Cells(iLineCounter, iColumnCounter).Value
			Else
				'preseve the array values
				Redim Preserve sLineArray(iColumnCounter) As String
				sLineArray(iColumnCounter) = xlsSheet.Cells(iLineCounter, iColumnCounter).Value
			End If
		Next
		
		' Verify which table is not empty.
		ValidationFlag = False						'reset variable
		For iCounter = 1 To Ubound(sLineArray)
			If sLineArray(iCounter) <> "" Then
				ValidationFlag = True
				Exit For
			Else
				ValidationFlag = False
			End If
		Next
		
		Print "Processing line " & iLineCounter & " of " & xlsLine
		
		'Create the document if the validationflag = true
		If ValidationFlag = True Then 
			'Create the new document
			Set doc = db.CreateDocument			
			'Name of the form
			doc.form = formname
			'Loop thru all the columns and set the values for each field
			For f = 1 To xlsColumn
				Call doc.ReplaceItemValue(Trim(sColumnArray(f)), sLineArray(f))
			Next f
			'Save the new doc
			Call doc.Save(True, False, False)
		End If
	Next
	
	Print "Closing Excel..."
	xlsWorkBook.Close False						' Close
	xlsApp.Quit											' Quit Excel
	Set xlsApp = Nothing								' Close Instance
	Print "Finished importing the Excel file"
	
	Call workspace.viewrefresh


Function replaceSubString(stringtosearch As String, char2replace As String, replacementchar As String) As String
	
	Dim returnValue As String
	Dim temp As String
	temp = stringtosearch
	Dim i As Integer
	i = Instr(temp, char2replace)
	
	While (i > 0)
		returnValue = _
		returnValue + _
		Left(temp, i -1) + replacementchar
		temp = Mid(temp, i + Len(char2replace))
		i = Instr(temp, char2replace)
	Wend
	
	returnValue = returnValue + temp
	
	replaceSubString = returnValue
	
End Function 

Posted by fbrefere001 on Friday January 27, 2006