Note: This will only work when run on a Windows platform with MS Office installed.
Sub ImportXL
%REM
This subroutine imports data from an
Excel Sheet.
Created by Dr. Nadir Patir
Istanbul Pazarlama A.S., Istanbul Turkey
E-Mail: nadir@istpaz.com.tr
This routine is used in TeamWork CRM
software of author.
EXCEL SHEET FORMAT:
Row 1 of Excel Sheet must contain
Field Names to be imported.
Column 1 of Excel Sheet must contain
Form name.
(You can import data to different forms
based on form name in column 1.)
Each row will be imported to a document.
%END REM
Dim ws As New NotesUIWorkspace
Dim session As New NotesSession
Dim db As NotesDatabase
Dim doc As NotesDocument
Dim item As NotesItem
Dim App As Variant, Wbook As Variant,
WSheet As Variant
Dim v As Variant
Dim row As Double
Dim form As String, fileXL As String,
calcf As String, t As String
Dim title(255) As String, x(1) As String
Dim k As Integer, cols As Integer
Dim cnt As Long
Set db = session.CurrentDatabase
Set App = CreateObject("Excel.Application")
App.Visible = False
'Choose Excel file
v=ws.OpenFileDialog(False,
"Please Select Excel File", "*.xls", "")
If Isempty(v) Then Exit Sub
fileXL=v(0)
cnt=0
App.Workbooks.Open fileXL
Set Wbook = App.ActiveWorkbook
Set WSheet = Wbook.ActiveSheet
If Wsheet.Cells(1, 1).Value<>"Form" Then
Messagebox "First Column of Excel
sheet must contain Form names"
Goto fin
End If
'Recalc question
x(0)="Yes"
x(1)="No"
calcf= ws.Prompt( PROMPT_OKCANCELLIST,
"CALC", "Calculate fields on
form during document Import?","No", x )
If calcf="" Then Exit Sub
'Read field names
cols=1
For k=1 To 255
title(k)=Wsheet.Cells(1, k).Value
If Trim(title(k))="" Then
cols=k-1
Exit For
End If
Next
'Import documents
row=2
form=Trim(Cstr(Wsheet.Cells(row, 1).Value))
Do While form<>""
Set doc=db.CreateDocument
doc.Form = form
For k=2 To cols
t=Trim(Cstr(Wsheet.Cells(row, k).Value))
If t<>"" Then
Set item = doc.ReplaceItemValue( title(k), t )
End If
Next
'Calculate
If calcf="Yes" Then
Call doc.ComputeWithForm(False,False)
End If
'Save
Call doc.Save(True,True)
cnt=cnt+1
Print cnt
row=row+1
form=Trim(Cstr(Wsheet.Cells(row, 1).Value))
Loop
fin:
Messagebox Cstr(cnt) + " documents imported"
App.Application.Quit
Set App = Nothing
Set Wbook = Nothing
Set Wsheet = Nothing
End Sub
Do you have comments on this tip? Let us know.
This was first published in April 2004