Here you go:
%REM
Created July 04, 2015 by Knud E Højslet/K E Højslet ApS
Prompts for NAB-file
Prompts for xls-file
Reads fieldnames from columns A-E
Test for existence of Full-name (Column C) i nab
Runs until empty cells in columns A and B
%END REM
Option Public
Option Declare
Sub Initialize
Const PROMPT_CHOOSEDATABASE = 13
Dim session As New NotesSession
Dim ws As New NotesUIWorkspace
Dim doc As NotesDocument, naDoc As NotesDocument
Dim db As NotesDatabase
Dim view As NotesView
Dim item As NotesItem
Dim flag As Variant
Dim inputfile As Variant
'Set db = session.currentdatabase
inputfile = ws.Prompt(PROMPT_CHOOSEDATABASE, "Select database . . .","Select the NAB where users are present.")
If Not(IsArray(inputfile)) Then
Print "No database selected. Action cancelled . . ."
Exit Sub
End If
Set db = New NotesDatabase(inputfile(0), inputfile(1))
If db.IsOpen Then
Print "Adding alias for users in " + inputfile(0) + "!!" + inputfile(1)
Else
MessageBox "Could not open database" + inputfile(0) + "!!" + inputfile(1)
Exit Sub
End If
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
Set view = db.GetView( "($Users)" )
Dim curInit As String, newAlias As String, newInternetAddress As string
timer1= Timer
inputfile = ws.OpenFileDialog( False , "Select Excel-file with users and aliases (or Cancel operation)" , , , )
If IsEmpty(inputfile) Then Exit Sub'
filename= inputfile(0)
batchRows= 20000 'process 20000 rows at a time
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 2) As String
'Fullname, Alias
DataArray=xlsheet.Range( "A1").Resize(batchRows, 2).Value 'get worksheet area of specified size
For y=1 To 2 'we assume max 2 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))<> "" Then 'when first column is empty, we assume that it's the end of data
Print CStr (curRow-2)
curInit = FullTrim(CStr(DataArray(x,1)))
Set naDoc = view.GetDocumentByKey( curInit , True)
If naDoc Is Nothing Then
Print "Findes ikke: " + curInit
Else
newAlias = CStr(DataArray(x,2))
'newInternetAddress = CStr(DataArray(x,4))
Set item = naDoc.Getfirstitem("FullName")
Call item.Appendtotextlist(newAlias)
'Set item = naDoc.Getfirstitem("InternetAddress")
'item.Values = newInternetAddress
Call naDoc.Save(True,False)
End If
'
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 "Done in " +Cstr(timer2-timer1)+" seconds"
End Sub