Lotus Domino script snippet Import from Excel
To import data from Excel into an IBM Notes database
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 |
Option Public Sub Initialize 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 On Error GoTo ErrorHandler Set db = session.CurrentDatabase fn= uiws.Prompt(1, "Alert", "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 '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 '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 '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=a 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 For i=1 To cols ReDim Preserve fd(i) fd(i)=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 msg="The field name "& fd(i) &" does not appear in the form you have chosen. Exiting import." MsgBox msg GoTo ErrorHandler End If 'flag=1 Skip: Next 'For i=1 To cols 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 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 many 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 Sub |