About This Code
Brief Description:
GetProfileField
Contributor:
Paul F Morris
Last Modified:
28 Jul 2006
OpenNTF Disclaimer
All of the program code and information presented in the OpenNTF.org Code Bin are provided "as-is", and should be used at your own risk. OpenNTF.org make no express or implied warranty about anything in the Code Bin, and OpenNTF.org will not be responsible or liable for any damage caused by the use or misuse of anything from this site. OpenNTF.org makes no guarantees about anything. Please thoroughly test all of the knowledge and code you find here before you attempt to use them in your production environment.
Code / Description
Here is a replacement for the @GetProfileField Formula command coded entirely in LotusScript. This example returns an array of strings in order to properly handle multi-value fields. To accomplish this the code makes use of an AddToArray function I grabbed from someone, but I cannot recall where. If you wrote this please accept my thanks and pat yourself on the back. ;-)
Usage / Example
Dim varUsers As Variant
Dim szUser As String
varUsers = GetProfileField("Users", "AppSettings","")
szUser = varUsers(0)
'=============================================
' Function GetProfileField
'=============================================
Function GetProfileField(fieldName As String, profileName As String, uniqueKey As String) As Variant
Dim profileField() As String
Dim session As New NotesSession
Dim db As NotesDatabase
Dim doc As NotesDocument
Dim item As NotesItem
Set db = session.CurrentDatabase
If uniqueKey <> "" Then
Set doc = db.GetProfileDocument(profileName, uniqueKey)
Else
Set doc = db.GetProfileDocument(profileName)
End If
Set item = doc.GetFirstItem(fieldName)
Forall v In item.Values
Call AddToArray(profileField, Cstr(v))
End Forall
GetProfileField = profileField
End Function ' get profile field
'=============================================
' Sub AddToArray
'=============================================
Sub AddToArray( iArray As Variant, newValue As String )
On Error Goto HandleError
If Isempty(iArray) Then
Redim iArray(0) As String
End If
If ( Ubound(iArray) = Lbound(iArray) ) And iArray(Ubound(iArray)) = "" Then ' raises error 200 if not initialized
' if we are a new array with nothing in it then do not increase size
IsInitialized:
iArray(Lbound(iArray)) = newValue
Else
Dim newSize As Integer
newSize = Ubound(iArray)+1
Redim Preserve iArray(newSize)
iArray(newSize) = newValue
'AddToArray = iArray
End If
Exit Sub
HandleError:
If Err = 200 Then ' uninitialized dynamic array
'( it's actually an array, but does not have a single value in it
Redim iArray( 0 To 0 )
Resume IsInitialized
Else
Print Err & " " & Error
Error Err, Error
Exit Sub
End If
End Sub ' add to array