VBS Script for modifying multi-value Active Directory display specifier

Question

Following the howto Extending the Active Directory Schema To Track Custom Info I'm able to setup a single-value schema attribute that is easily changeable via a context menu in ADUC. Multi-value schema attributes get considerably more complicated. Say (for the sake of argument) my value is "Projects" and each user may be a list as many projects as necessary.

Following is a sad little script that will set Project to a single value:

Dim oproject
Dim oUser1
Dim temp1
Set oproject = Wscript.Arguments
Set oUser1 = GetObject(oproject(0))
temp1 = InputBox("Project: " & oUser1.project & vbCRLF & vbCRLF & "Project")
if temp1 <> "" then oUser1.Put "project",temp1
oUser1.SetInfo
Set oUser1 = Nothing
Set oproject = Nothing
Set temp1 = Nothing
WScript.Quit

How can I modify this to allow, assign, and modify multiple values?

Answer 1

I gave up on an elegant UI and just went with the semicolon delimited list. Here's the code if anyone cares:

Dim objProject
Dim objUser
Dim temp1, title, message, default
Dim projects
title = "Projects"

Set objProject = Wscript.Arguments
Set objUser = GetObject(objProject(0))

'Find our current projects
projects = objUser.projects
If Not isArray(projects) Then
    projects = Array(projects)
End If

'Setup our message box
message = "Semicolon-delimited list of Projects"
default = arrayToStr(projects)
temp1 = InputBox(message, title, default)

'catch cancels
if IsEmpty(temp1) Then
    WScript.Quit
End If

' update our data
projects = strToArray(temp1)
objUser.Put "projects",projects
objUser.SetInfo

'Clean up and quit
Set projects = Nothing
Set objUser = Nothing
Set objProject = Nothing
Set temp1 = Nothing
Set title = Nothing
Set message = Nothing
Set default = Nothing
WScript.Quit

'Functions
Function strToArray(s)
    Dim a
    Dim token

    ' discard blank entries
    For Each token in split(s, ";")
     token = trim(token)
     If token <> "" Then
      If isEmpty(a) Then
       a = token
      Else
       a = a & ";" & token
      End If
     End If
    Next

    ' return array
    strToArray = split(a, ";")
End Function
Function arrayToStr(a)
    Dim s
    Dim token

    For Each token in a
     If isEmpty(s) Then
      s = token
     Else
      s = s & ";" & token
     End If
    Next

    ' return string
    arrayToStr = s
End Function