Subject: Importing the excel sheet
This is an agent I use to import excel spreadsheets.I use a profile doc with the fields below: ( you could hardcode them)
File Path to excel file? (filepath - Text)
Form to use ? (import_form - Text)
Start at Row ? (Row_start - Number)
End Row after how many blank lines? (Row_end_count - Number)
In what col? (Row_end_col - Number)
Start at Col ? ((Col_end - Number)
End at Col (Col_end - Number)
Field List : (FieldNames - TEXTLIST)
Sub Initialize
On Error Goto ErrorHandler
Dim profile As NotesDocument
Dim ndoc As NotesDocument
Dim WS As New Notesuiworkspace
Dim agent As NotesAgent
Dim doc As NotesDocument
Dim xlApp As Variant, xlsheet As Variant, rows As Integer, cols As Integer
Dim xlwookbook As Variant, xlapplication As Variant
Dim x As Integer
Dim import_column As Variant
Dim Import_number As Variant
Dim fieldname_list As Variant
Dim fieldname As String
Dim Row_start As Integer
Dim Row_end_count As Integer
Dim Row_end_col As Integer
Dim Col_start As Integer
Dim Col_end As Integer
Dim filepath As String
Dim row As Integer
Dim end_count As Integer
Dim col As Integer
Dim Import_List As Variant
Dim Import_Type As String
Dim xlcolums As Variant
Dim datavalue As Variant
Dim form As String
Dim importdate As Variant
Set session = New NotesSession
Set db = session.CurrentDatabase 'link to current database
Set Import_view = db.GetView("Excel IMPORT")
If Import_view Is Nothing Then
Set Import_view = db.CreateView
Import_view.Name = "Excel IMPORT"
End If
importdate = Now
Import_view.SelectionFormula = |IMPORT_DATE = "|& Cstr(importdate) &|"|
import_column = Import_view.Columns
If Not Isempty( import_column) Then
For x = 0 To Import_view.ColumnCount
Call Import_view.RemoveColumn( 1 )
Next
End If
Set agent = session.CurrentAgent
Import_number = agent.ParameterDocID
If Import_number = "" Then Import_number = 0
Set profile = db.GetProfileDocument("ExceIImportProfile","IMPORT")
Import_List = profile.GetItemValue("ImportList")
Import_Type = ws.Prompt(4,"Import From Excel","Select the import you would like to run.","", Import_List)
’ Import_List( Import_number)
Set profile = db.GetProfileDocument("ExceIImportProfile", Import_Type)
fieldname_list = profile.FieldNames
Row_start = profile.Row_start(0)
Row_end_count = profile.Row_end_count(0)
Row_end_col = profile.Row_end_col(0)
Col_start = profile.Col_start(0)
Col_end = profile.Col_end(0)
filepath = profile.filepath(0)
form = profile.import_form(0)
Set xlApp = CreateObject("Excel.Application") 'start Excel with OLE Automation
If filepath = "" Then
xlApp.Visible = True
xlApp.FindFile
Else
xlApp.Visible = False
xlApp.Application.Workbooks.Open filepath
Print filepath
End If
Set xlsheet = xlApp.Activesheet
Set xlcolums = xlsheet.Columns
cols = Col_start
row = Row_start
end_count = 0
While Row_end_count > end_count
If xlsheet.Cells(row,Row_end_col).Value = "" Then
end_count = end_count +1
Else
end_count = 0
Set ndoc = newpage(form)
For col = Col_start To Col_end
datavalue = xlsheet.Cells(row,col).Value
fieldname = Fulltrim(fieldname_list(col - Col_start ))
If row = Row_start Then
Call newcolumn(fieldname)
End If
If Not fieldname = "~~~~" Then
Dim fitem As NotesItem
Set fitem = New NotesItem(ndoc , fieldname ,datavalue)
fitem.IsSummary = True
End If
Next
ndoc.IMPORT_DATE = Cstr(importdate)
Call ndoc.save(True,True)
End If
row = row + 1
Wend
xlApp.Application.Workbooks.Close
Set xlapp=Nothing 'stop OLE
Set xlsheet = Nothing
Set xlcolums = Nothing
Set db=Nothing
Exit Sub
ErrorHandler:
Stop
Print "Error" & Str(Err) & ": " & Error$ & Str(x)
Resume Next
End Sub
Function newpage(Form As String) As NotesDocument
On Error Goto ErrorCheck
Dim ndoc As NotesDocument
Set newpage = Nothing
Set ndoc = db.CreateDocument
ndoc.Form = Form
ndoc.~$ConflictAction = "3"
Set newpage = ndoc
Exit Function
ErrorCheck:
Stop
Print "Error" & Str(Err) & ": " & Error$
Resume Next
End Function
Sub newcolumn(formula As String)
On Error Goto ErrorCheck
Set viewcol = Import_view.CreateColumn()
viewcol.HeaderAlignment = VC_ALIGN_CENTER
viewcol.HeaderFontFace = "Default San Serif"
viewcol.HeaderFontPointSize = 9
viewcol.HeaderFontStyle = VC_FONT_PLAIN
viewcol. Formula = formula
viewcol.Title = formula
viewcol.Alignment = VC_ALIGN_CENTER
viewcol.FontFace = "Default San Serif"
viewcol.FontStyle = VC_FONT_PLAIN
viewcol.FontPointSize = 8
viewcol.FontColor = COLOR_DARK_BLUE
viewcol.DateFmt = VC_FMT_MD
viewcol.TimeDateFmt = VC_FMT_DATE
viewcol.Width = 10
Exit Sub' use the lines below in all code sets
ErrorCheck:
Print "Error" & Str(Err) & ": " & Error$
Resume Next ' remove this line if you want everything to stop
End
End Sub
David C Slatter
210-697-1390