I need to import an excel file. I am using the following agent (which is successfully working if the fields are in a single row) however I need help in modifying it. I would like the agent to read from the excel 7 columns A-G and almost 300 rows and import the data in the corresponding fields in Lotus which their naming convention on every row is A1-G1, every cell (column) A2-A200, B2-B200 etc). Thanking you in advance.
Here is the agent:
Sub Initialize
'This agent imports records from excel to Notes.
Dim session As New NotesSession
Dim db As NotesDatabase
Dim doc As NotesDocument
Dim docPostCode As NotesDocument
Dim xlApp As Variant, xlsheet As Variant, xlwb As Variant, xlrange As Variant
Dim filename As String, currentvalue As String
Dim batchRows As Integer, batchColumns As Integer, totalColumns As Integer
Dim x As Integer, y As Integer, startrow As Integer
Dim curRow As Long, timer1 As Long, timer2 As Long
Dim DataArray, fieldNames, hasData
Dim view As NotesView
Set db2 = session.CurrentDatabase
Set view = db2.GetView("page_zones")
Set docPostCode = view.GetFirstDocument
timer1=Timer
filename="C:\zones.xls"
batchRows=500 'process 500 rows at a time
Set db=session.CurrentDatabase
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True 'set Excel program to run in foreground to see what is happening
Set xlwb=xlApp.Workbooks.Open(filename)
Set xlsheet =xlwb.Worksheets(1)
Redim fieldNames(1 To 6) As String
DataArray=xlsheet.Range("A1").Resize(batchRows, 2).Value 'get worksheet area of specified size
For y=1 To 2 'we assume max 9 columns in the sheet
currentvalue=Cstr(DataArray(1,y))
If currentvalue<>"" Then 'abort counting on empty column
fieldNames(y)=currentvalue 'collect field names from the first row
totalColumns=y
Else
y=2
End If
Next
Redim Preserve fieldNames(1 To totalColumns) As String
curRow=2
hasData=True
While hasData=True 'loop until we get to the end of Excel rows
If curRow=2 Then startrow=2 Else startrow=1
For x=startrow To batchRows
curRow=curRow+1
If Cstr(DataArray(x,1))+Cstr(DataArray(x,2))<>"" Then 'when 2 first columns are empty, we assume that it's the end of data
Print Cstr(curRow-2)
Set doc=New NotesDocument(db)
doc.Form="zones"
doc.Type = "zones"
For y=1 To totalColumns
currentvalue=Cstr(DataArray(x,y))
Call doc.ReplaceItemValue(fieldNames(y), currentvalue)
Next
Call doc.save(True, False)
Else
hasData=False
x=batchRows
End If
Next
If hasData=True Then DataArray=xlsheet.Range("A"+Cstr(curRow)).Resize(batchRows, totalColumns).Value 'get worksheet area
Wend
timer2=Timer
Call xlApp.Quit() 'close Excel program
Msgbox "... "+Cstr(timer2-timer1)+" seconds" , ,"..."
End Sub