OC.CreatePSLearnUser: Create PeopleSoft Campus Solutions user

Author: Robert Lawson
Environment: Windows Server, Access/VBA, Microsoft SQL Server, PeopleSoft
Description: This code creates a PeopleSoft Campus Solutions user for a student, and is part of the OneCard system. All students require this user and are given the same access. This account is created in sync with the Active Directory account, so that LDAP authentication can be readily accomplished.
Features:
- Writes to application event log
- Email administrator upon any error
- PeopleSoft user created to work with LDAP authentication
Sample:

Code:

Public Sub CreatePSLearnUser(strID As String, strUType As String, bolOnLine As Boolean, intStatus2 As Integer)

' Creates PeopleSoft Learning Solutions 8.8 user

' 08-Jun-2006  Robert Lawson Creation date (Learning Solutions 8.1/PeopleTools 8.22)

' 23-Apr-2008  Robert Lawson Updated for Campus Solutions 9.0

' **** NOTE, this is centric to student in AV, any other user must look closely!!! ***************



' strID                Passed      OneCard ID number

' strUType             Passed      User Type from GetUtype function

' bolOnLine            Passed      TRUE=you're interactive

' IntStatus2           Returned    0=OK, <>0 You're not OK

On Error GoTo ErrorBegin

Dim strName As String

strName = "CreatePSLearnUser"



Dim intStatus As Integer

Dim objRS As ADODB.Recordset, objRS2 As ADODB.Recordset

Dim strNETUser As String, strNETEmail As String, strFullName As String, strPeopleSoftID As String

Dim strEmailType As String, strGroupRole As String, strOprClass As String, strEnrlAccessGroup As String



intStatus2 = 0

strMessage = conNoMessage



Call LoadSysDbconn(intStatus)

If intStatus <> 0 Then

    strMessage = "Error calling LoadSysDbconn."

    Err.Raise (vbObjectError + 10), , strMessage

    GoTo ErrorBegin

End If

strTodayDate = Format(Now(), "mm/dd/yyyy")

' Get person's info

strSQL = "SELECT * FROM OneCardMaster WHERE ID = '" & strID & "'"

Debug.Print strSQL

Set objRS = CreateObject("ADODB.Recordset")

objRS.Open strSQL, conDbOneCard, adOpenDynamic, adLockReadOnly ' read access

With objRS

If (.BOF Or .EOF) Then

    strMessage = strName & ": Unable to get OneCardMaster record for ID = " & strID

    intStatus2 = -10

    GoTo ErrorBegin

Else

    strNETUser = Nz(!NETUser, "")

    strNETEmail = Nz(!NETEMail, "")

    strPeopleSoftID = Nz(!PeopleSoftID, "")

    strFullName = Trim(Nz(!NameFirst, "")) & " " & Trim(Nz(!NameLast, ""))

End If

End With

Set objRS = Nothing



' Can not create user without these key items!

If Len(strNETUser) = 0 Or Len(strNETEmail) = 0 Then

    strMessage = strName & ":Unable to get NETUser or NETEmail for = " & strID

    intStatus2 = -20

    GoTo ErrorBegin

End If



' Figure out which role to give them

If strUType = "STAFF" Then

    strGroupRole = "?"

    strEnrlAccessGroup = "?"

    strOprClass = "?"

ElseIf strUType = "FACULTY" Then

    strGroupRole = "?"

    strEnrlAccessGroup = "?"

    strOprClass = "?"

ElseIf strUType = "SOKASTUDENT" Then

    strGroupRole = conGroupRoleStudent

    strEnrlAccessGroup = conEnrlAccessGroupStudent

    strOprClass = conOprClassStudent9

Else

    strGroupRole = "?"

    strEnrlAccessGroup = "?"

    strOprClass = "?"

End If



' This type is not yet figured out

If strGroupRole = "?" Then

    strMessage = strName & ": Unable to get role for type = " & strUType & " for ID = " & strID

    intStatus2 = -25

    GoTo ErrorBegin

End If



' See if user already setup

strSQL = "SELECT * FROM PSOPRDEFN WHERE OPRID = '" & strNETUser & "'"

Debug.Print strSQL

Set objRS = CreateObject("ADODB.Recordset")

objRS.Open strSQL, conDbPSLearn, adOpenDynamic, adLockReadOnly ' read access

If Not (objRS.BOF Or objRS.EOF) Then

    strMessage = strName & ": User already setup in PSOPRDEFN for ID = " & strID

    intStatus2 = -30

    GoTo ErrorBegin

End If

Set objRS = Nothing



' --- Add PSOPRDEFN (actual user)

Set objRS = CreateObject("ADODB.Recordset")

strSQL = "PSOPRDEFN"

Debug.Print strSQL

objRS.Open strSQL, conDbPSLearn, adOpenStatic, adLockPessimistic ' write access



With objRS

.AddNew

!OPRID = strNETUser

!Version = 1

!OPRDEFNDESC = strFullName

!EMPLID = strPeopleSoftID

!EMAILID = strNETEmail

!OPRCLASS = strOprClass

!ROWSECCLASS = strOprClass

!OPERPSWD = conLearnOPERPSWD

!ENCRYPTED = 1

!SYMBOLICID = conLearnSYMBOLICID

!LANGUAGE_CD = "ENG"

!MULTILANG = 0

!CURRENCY_CD = "USD"

!LASTPSWDCHANGE = strTodayDate

!ACCTLOCK = 0

!PRCSPRFLCLS = strOprClass

!DEFAULTNAVHP = conStdDEFAULTNAVHP

!FAILEDLOGINS = 0

!EXPENT = 0

!OPRTYPE = 0

!USERIDALIAS = conBlank

!LASTSIGNONDTTM = Null

!LASTUPDDTTM = strTodayDate

!LASTUPDOPRID = conPLearnLASTUPDOPRID

!PTALLOWSWITCHUSER = 0

.Update

End With

Set objRS = Nothing



' ----- Add PSOPRALIAS (EMPLID reference)

Set objRS = CreateObject("ADODB.Recordset")

strSQL = "PSOPRALIAS"

Debug.Print strSQL

objRS.Open strSQL, conDbPSLearn, adOpenStatic, adLockPessimistic ' write access



With objRS

.AddNew

!OPRID = strNETUser

!OPRALIASTYPE = "EMP"

!OPRALIASVALUE = strPeopleSoftID

!SETID = conBlank

!EMPLID = strPeopleSoftID

!CUST_ID = conBlank

!VENDOR_ID = conBlank

!APPLID = conBlank

!CONTACT_ID = conBlank

!PERSON_ID = conBlank

!EXT_ORG_ID = conBlank

!BIDDER_ID = conBlank

!EOTP_PARTNERID = 0

.Update

End With

Set objRS = Nothing



' ----- Add PS_ROLEXLATOPR

Set objRS = CreateObject("ADODB.Recordset")

strSQL = "PS_ROLEXLATOPR"

Debug.Print strSQL

objRS.Open strSQL, conDbPSLearn, adOpenStatic, adLockPessimistic ' write access



With objRS

.AddNew

!ROLEUSER = strNETUser

!DESCR = strFullName

!OPRID = strNETUser

!EMAILID = strNETEmail

!FORMID = conBlank

!WORKLIST_USER_SW = "Y"

!EMAIL_USER_SW = "Y"

!FORMS_USER_SW = "Y"

!EMPLID = strPeopleSoftID

!ROLEUSER_ALT = conBlank

!ROLEUSER_SUPR = conBlank

!EFFDT_FROM = Null

!EFFDT_TO = Null

.Update

End With

Set objRS = Nothing

Debug.Print strSQL



' ----- Add PSROLEUSER (gives security role)

Set objRS = CreateObject("ADODB.Recordset")

strSQL = "PSROLEUSER"

Debug.Print strSQL

objRS.Open strSQL, conDbPSLearn, adOpenStatic, adLockPessimistic ' write access



With objRS

.AddNew

!ROLEUSER = strNETUser

!ROLENAME = conGroupRoleStudent9  ' 1

!DYNAMIC_SW = "N"

.Update

.AddNew

!ROLEUSER = strNETUser

!ROLENAME = "EOPP_USER"   ' 2

!DYNAMIC_SW = "N"

.Update

.AddNew

!ROLEUSER = strNETUser

!ROLENAME = "SUA_PAPP_USER"   ' 3

!DYNAMIC_SW = "N"

.Update

.AddNew

!ROLEUSER = strNETUser

!ROLENAME = "GENERAL_PEOPLESOFTUSER" ' 4

!DYNAMIC_SW = "N"

.Update

.AddNew

!ROLEUSER = strNETUser

!ROLENAME = "SUA_Standard Non-Page Perms" ' 5

!DYNAMIC_SW = "N"

.Update

End With

Set objRS = Nothing



' ----- Add PS_OPR_DEF_TBL_CS (enables self-serve)

Set objRS = CreateObject("ADODB.Recordset")

strSQL = "PS_OPR_DEF_TBL_CS"

Debug.Print strSQL

objRS.Open strSQL, conDbPSLearn, adOpenStatic, adLockPessimistic ' write access



With objRS

.AddNew

!OPRID = strNETUser

!SETID = conBlank

!INSTITUTION = "SUA"

!BUSINESS_UNIT = conBlank

!ACAD_GROUP = conBlank

!Subject = conBlank

!STRM = conBlank

!ACAD_PROG = conBlank

!ACAD_PLAN = conBlank

!ACAD_SUB_PLAN = conBlank

!AID_YEAR = conBlank

!ACAD_CAREER = conBlank

!SETID_FACILITY = conBlank

!SETID_CAREER = conBlank

!ENRL_ACCESS_ID = conBlank

!OVRD_CLASS_LIMIT = "N"

!OVRD_UNIT_LOAD = "N"

!OVRD_CLASS_PRMSN = "N"

!OVRD_REQUISITES = "N"

!OVRD_TIME_CNFLCT = "N"

!WAIT_LIST_OKAY = "N"

!OVRD_ENRL_ACTN_DT = "N"

!CARRY_ID = "Y"

!ADM_RECR_CTR = conBlank

!ADM_APPL_CTR = conBlank

!CASHIER_OFFICE = conBlank

!DEPTID = conBlank

!ADMIT_TYPE = conBlank

!CAMPUS = conBlank

!OUTPUT_DEST = conBlank

!ACADEMIC_LEVEL = conBlank

!ADM_APPL_METHOD = conBlank

!TSCRPT_TYPE = conBlank

!ENRL_ACCESS_GROUP = strEnrlAccessGroup

!HOUSING_INTEREST = conBlank

!FIN_AID_INTEREST = "N"

!TRANSCRIPT_TYPE = conBlank

!DATA_MEDIUM_RCVD = conBlank

!DATA_SOURCE_RCVD = conBlank

!LAST_SCH_ATTEND = conBlank

!GRADUATION_DT = Null

!INSTITUTION_SET = "SUA"

!ISET_OVRD = "SUA"

!SEV_SCHOOL_CD = conBlank

!SEV_PRG_NBR = conBlank

!PRINTER_NAME = conBlank

!SAA_TSCRPT_TYPE = conBlank

.Update

End With

Set objRS = Nothing



' Write to trans log table, table = SUB-USER, field = PeopleSoft Portal

Call DoDataLog(strName, "IN", "SUB-USER", "PeopleSoft Learn", "", strID, strID, bolOnLine)



ExitBegin:

    Exit Sub



ErrorBegin:

    If intStatus2 = 0 Then ' General message

        strMessage = "Error in " & strName & " " & Err.Number & " " & Err.Description & " on strID = " & Nz(strID, "")

        intStatus2 = -100 ' I'm NOT OK

    End If

    If bolOnLine Then MsgBox strMessage

    Call DoEventLog("ERR", strName, 500, strMessage, True, bolOnLine)

    GoTo ExitBegin

End Sub