General scriptlibrary for importing EXCEL to notes

Many people asked me how to import Excel and made a general scriptlibrary for importing EXCEL to notes, which is very convenient,

Requirements for Excel files: the first line of Excel must be the same as fieldname in notes form.

Usage example:

Call importexcel ("") 'will show all the forms of the current data for the user to select

Or

Call importexcel (formname)

 

Create a script Library:

Function importexcel (formname as string)
Dim session as new notessession
Dim uiws as new notesuiworkspace
Dim form as notesform
Dim dB as notesdatabase
Dim doc as notesdocument
Dim item as notesitem
Dim row as integer
Dim xlfilename as string
Dim xlsapp as Variant
Dim xlsworkbook as Variant
Dim xlssheet as Variant
Dim rows as long
Dim Cols as integer
Dim X as integer
Dim itemname as string
Dim flag as integer
Dim formalias as string
Dim sorteval as string
Dim sortedlist as Variant
Dim indexlo as long
Dim indexhi as long
Dim t as integer
Dim askme as integer


On Error goto errorhandler
'====== 1. Set form name, not select from form List ======

Set DB = session. currentdatabase

Fn = uiws. Prompt (1, "reminder-Excel worksheet setup", "Make sure that the first row of your worksheet contains the exact Notes document field names from your form .")

'Get Excel file name
Fn = uiws. openfiledialog (false, "select the Excel file to import", "Excel files | *. xls", "C: My Documents ")
Xlfilename = CSTR (FN (0) 'This is the name of the Excel file that will be imported

If formname = "" then
'Get list of form names
X = 0

Print "Preparing list of database forms ..."

Forall F in db. Forms
Redim preserve formlist (X)
Formlist (x) = F. Name
X = x + 1
Print "Preparing list of database forms..." & CSTR (X)
End forall

'Sort the form names for the dialog box
Indexlo = lbound (formlist)
Indexhi = ubound (formlist)
Call quicksort (formlist, indexlo, indexhi)

'Choose the form to use for Import
Formname = uiws. Prompt (4, "Choose import form", "Please select which form is to be used for this input.", formlist (0), formlist)
If formname = "" Then end
End if

'Get the form object so that we can check Field Names
Set form = dB. getform (formname)

'If the form has an alias, use it to select the form
If not isempty (Form. aliases) then
Forall A in form. aliases
Formname =
End forall 'a in form. aliases
End if 'not isempty (Form. aliases)

'Next we connect to excel and open the file. Then start pulling over the records.
Print "connecting to excel ..."

'Create the Excel Object
Set xlsapp = Createobject ("Excel. application ")

'Open the file
Print "opening the file:" & xlfilename
Xlsapp. workbooks. Open xlfilename
Set xlsworkbook = xlsapp. activeworkbook
Set xlssheet = xlsworkbook. activesheet
Xlsapp. Visible = false 'do not show EXCEL to user
Xlssheet. cells. specialcells (11). Activate
Rows = xlsapp. activewindow. activecell. Row 'number of rows to process
Cols = xlsapp. activewindow. activecell. Column 'number of columns to process

'Make sure we start at row 0
Row = 0
Print "starting import from Excel file ..."

Do While true
Row = row + 1

'Check to make sure we did not run out of rows
If ROW = rows + 1 Then goto done

'Field definitions for notes come from first row (row, column)
If ROW = 1 then
Redim misfd (0)
T = 0
For I = 1 to Cols
Redim preserve FD (I)
'The replace function used here removes spaces from the field definitions in the first row
FD (I) = Replace (xlssheet. cells (row, I). value ,"","")

Flag = 0

Forall F in form. Fields
If lcase (FD (I) = lcase (f) Then flag = 1
End forall 'f in form. Fields

If flag = 1 then
Goto skip
End if 'flag = 1

If not flag = 1 then
Misfd (t) = FD (I)
T = t + 1
Redim preserve misfd (t)
End if 'flag = 1

SKIP:
Next 'for I = 1 to Cols

If T> 0 then redim preserve misfd (t-1)
If misfd (0) <> "then
MSG = "below field (s) does not appear in the form you have chosen, Are you sure continue? "+ CHR (10) + CHR (10)
For I = 0 to ubound (misfd)
MSG = MSG + misfd (I) + CHR (10)
Next
Askme = uiws. Prompt (2, "Please notice", MSG)
If askme <> 1 then
Goto errorhandler
End if
End if

End if 'row = 1



'Import each row into a new document
If not ROW = 1 then

'Create a new doc
Set Doc = dB. createdocument
Doc. form = formname
Doc. hiddeleted = 0
For I = 1 to Cols
Set item = Doc. replaceitemvalue (FD (I), xlssheet. cells (row, I). value)
Next 'I = 1 to Cols

'Save the new doc
Call Doc. Save (True, true)

End if 'not ROW = 1 then

Print "processing document number" & CSTR (ROW) & "of" & CSTR (rows)

Loop 'do while true

Done:

Print "disconnecting from Excel ..."
'Close the Excel file without saving (we made no changes)
Xlsworkbook. Close false
'Close Excel
Xlsapp. Quit
'Free the memory that we 'd used
Set xlsapp = nothing

'Clear the status line
Print ""


Errorhandler:
If err = 184 then
Msgbox "no file chosen. exiting import ."
Print "no file chosen. exiting import ."
Resume errorout
End if 'err = 184

If err = 6 then
MessageBox "make sure that you do not have more than 65,536 rows of data to import.", mb_ OK + mb_iconinformation, "error! "
Print "too into rows in Excel document. exiting import. Disconnecting From Excel ..."
'Close the Excel file without saving (we made no changes)
Xlsworkbook. Close false
'Close Excel
Xlsapp. Quit
'Free the memory that we 'd used
Set xlsapp = nothing
Resume errorout
End if 'err = 184

If (ERR) and (not err = 184) and (not err = 6) then

Msgbox "Lotus Notes Error #" & err & ". Please contact your Notes administrator for help. exiting import ."
Print "Error #" & err

If not xlsworkbook is nothing then
Xlsworkbook. Close false
End if 'not xlsworkbook is nothing

If not xlsapp is nothing then
Xlsapp. Quit false
End if 'not xlsapp is nothing

Resume errorout

End if '(ERR) and (not err = 184) and (not err = 6)

Errorout:
End Function

Function quicksort (anarray as variant, indexlo as long, indexhi as long) as Variant

Dim Lo as long
Dim HI as long
Dim midvalue as string
Dim tmpvalue as string

Lo = indexlo
Hi = indexhi
If (indexhi> indexlo) then
'Get the middle element
Midvalue = anarray (indexlo + indexhi)/2)
While (Lo <= Hi)
'Find first element greater than middle
While (Lo <indexhi) and (anarray (LO) <midvalue)
Lo = lo + 1
Wend
'Find first element smaller than middle
While (HI> indexlo) and (anarray (HI)> midvalue)
Hi = Hi-1
Wend
'If the indexes have not crossed, swap
If (Lo <= Hi) then
Tmpvalue = anarray (LO)
Anarray (LO) = anarray (HI)
Anarray (HI) = tmpvalue
Lo = lo + 1
Hi = Hi-1
End if
Wend
'If the right index has not reached the left side of array, sort it again
If (indexlo Call quicksort (anarray, indexlo, hi)
End if
'If the left index has not reached the right side of array, sort it again
If (Lo <indexhi) then
Call quicksort (anarray, lo, indexhi)
End if
End if

Quicksort = anarray

End Function