Labels

Monday, June 11, 2012

How to Create User, Add User to Project and Assign Role by using Macro with Site Admin API ?

Dim result As String
Const m_SERVER As String = "http://xxx/qcbin"
Const m_USER As String = "Admin User Name"
Const m_PASS As String = "Password"
Function CreateUser(ByVal user As String, _
                ByVal fullname As String, _
                ByVal email As String, _
                ByVal phone As String, _
                ByVal description As String, _
                ByVal password As String, _
                ByVal domain As String)
    If Len(user) < 1 Or Len(domain) < 1 Then
        CreateUser = "MI"
    Else
        If isUserExist(user) = True Then
            CreateUser = "AE"
        Else
            CreateUser = SAClient.CreateUserEx(user, fullname, email, phone, description, password, domain)
        End If
    End If
   
   
End Function
Function AddUserToProject(ByVal domain As String, _
                ByVal project As String, _
                ByVal user As String)
    If Len(user) < 1 Or Len(domain) < 1 Or Len(project) < 1 Then
        AddUserToProject = "MI"
    Else
        If isUserExist(user) = True Then
            If isProjectExist(project, domain) = True Then
                On Error GoTo err
                SAClient.AddUsersToProject domain, project, user
                AddUserToProject = "Success"
            Else
                AddUserToProject = "NP"
            End If
        Else
            AddUserToProject = "NU"
        End If
    End If
    Exit Function
err:
    AddUserToProject = err.description
End Function
Function AddUserToGroup(ByVal domain As String, _
                ByVal project As String, _
                ByVal group As String, _
                ByVal user As String)
    If Len(user) < 1 Or Len(domain) < 1 Or Len(project) < 1 Then
        AddUserToGroup = "MI"
    Else
        If isUserExist(user) = True Then
      On Error GoTo err
           
         SAClient.AddUsersToGroup domain, project, group, user
         AddUserToGroup = "Success"
        
         Else
           AddUserToGroup = "NU"
          
         End If
     Exit Function
             
        
    End If
err:
    AddUserToGroup = err.description
End Function
Function DeleteUser(ByVal user As String)
    If isUserExist(user) = True Then
        DeleteUser = SAClient.DeleteUser(user)
    Else
        DeleteUser = "NU"
    End If
End Function
Sub ProcessUsers()
    ' login
    SAClient.Login m_SERVER, m_USER, m_PASS
    ' loop through excel data
    ' process users
    Sheets("Users").Select
    Range("A1").Select
    Selection.End(xlDown).Select
    '
    Dim i As Integer
    Dim j As Integer
    '
    i = ActiveCell.Row
    For j = 2 To i
        Sheets("Users").Select
        Debug.Print "------------------------------"
        Debug.Print Cells(j, 1)
        result = CreateUser(Cells(j, 1), Cells(j, 2), Cells(j, 3), Cells(j, 4), Cells(j, 5), Cells(j, 6), Cells(j, 7))
        If result = "MI" Then
            Cells(j, 1).Interior.Color = RGB(255, 0, 0)
            Cells(j, 8).Select
            Selection.Value = "Missing Information"
            Debug.Print "--Missing Information"
        ElseIf result = "AE" Then
            Cells(j, 1).Interior.Color = RGB(255, 255, 0)
            Cells(j, 8).Select
            Selection.Value = "User Exists"
            Debug.Print "--user already exists"
        Else
            Cells(j, 1).Interior.Color = RGB(0, 255, 0)
            Cells(j, 8).Select
            Selection.Value = "Success"
            Debug.Print "--created successfully"
        End If
    Next
    ' logout
    SAClient.Logout
End Sub
Sub ProcessProjects()
    ' login
    SAClient.Login m_SERVER, m_USER, m_PASS
    ' loop through excel data
    ' process users
    Sheets("Projects").Select
    Range("A1").Select
    Selection.End(xlDown).Select
    '
    Dim i As Integer
    Dim j As Integer
    '
    i = ActiveCell.Row
    For j = 2 To i
        Debug.Print "------------------------------------------------------"
        Sheets("Projects").Select
        Debug.Print "Adding user " & Cells(j, 1) & " to project " & Cells(j, 2)
        result = AddUserToProject(Cells(j, 3), Cells(j, 2), Cells(j, 1))
        Select Case result
            Case "MI"
                Cells(j, 1).Interior.Color = RGB(255, 0, 0)
                Cells(j, 4).Select
                Selection.Value = "Missing Information"
                Debug.Print "--Missing Information"
            Case "NU"
                Cells(j, 1).Interior.Color = RGB(255, 0, 0)
                Cells(j, 4).Select
                Selection.Value = "User doen't exist"
                Debug.Print "--User not exist"
            Case "NP"
                Cells(j, 1).Interior.Color = RGB(255, 0, 0)
                Cells(j, 4).Select
                Selection.Value = "Project doen't exist"
                Debug.Print "--Project not exist"
            Case "Success"
                Cells(j, 1).Interior.Color = RGB(0, 255, 0)
                Cells(j, 4).Select
                Selection.Value = "Succes"
                Debug.Print "--added successfully"
            Case Else
                Cells(j, 1).Interior.Color = RGB(255, 0, 0)
                Cells(j, 4).Select
                Selection.Value = "Missing Information" & result
                Debug.Print "--" & result
        End Select
    Next
    ' logout
    SAClient.Logout
End Sub
Sub ProcessGroups()
    ' login
    SAClient.Login m_SERVER, m_USER, m_PASS
    ' loop through excel data
    ' process users
    Sheets("Groups").Select
   
    Range("A1").Select
    Selection.End(xlDown).Select
    '
    Dim i As Integer
    Dim j As Integer
    '
    i = ActiveCell.Row
    For j = 2 To i
        Sheets("Groups").Select
        Debug.Print "Adding user to group " & Cells(j, 1) & " to project " & Cells(j, 2)
        result = AddUserToGroup(Cells(j, 4), Cells(j, 3), Cells(j, 2), Cells(j, 1))
       
                Select Case result
            Case "MI"
                Cells(j, 1).Interior.Color = RGB(255, 0, 0)
                Cells(j, 5).Select
                Selection.Value = "Missing Information"
                Debug.Print "--Missing Information"
            Case "NU"
                Cells(j, 1).Interior.Color = RGB(255, 0, 0)
                Cells(j, 5).Select
                Selection.Value = "User doesn't exist"
                Debug.Print "--User not exist"
            Case "NP"
                Cells(j, 1).Interior.Color = RGB(255, 0, 0)
                Cells(j, 5).Select
                Selection.Value = "Project doen't exist"
                Debug.Print "--Project not exist"
            Case "Success"
                Cells(j, 1).Interior.Color = RGB(0, 255, 0)
                Cells(j, 5).Select
                Selection.Value = "Sucess"
                Debug.Print "--added successfully"
            Case Else
                Cells(j, 1).Interior.Color = RGB(255, 0, 0)
                Cells(j, 5).Select
                Selection.Value = "Error" & result
                Debug.Print "--" & result
        End Select
       
    Next
    ' logout
    SAClient.Logout
End Sub
Sub ProcessDelete()
    ' login
    SAClient.Login m_SERVER, m_USER, m_PASS
    ' loop through excel data
    ' process users
    Sheets("Users").Select
    Range("A1").Select
    Selection.End(xlDown).Select
    '
    Dim i As Integer
    Dim j As Integer
    '
    i = ActiveCell.Row
    For j = 2 To i
        Sheets("Users").Select
        result = DeleteUser(Cells(j, 1))
        If result = "NU" Then
            Cells(j, 1).Interior.Color = RGB(0, 255, 255)
        Else
            Cells(j, 1).Interior.ColorIndex = 0
        End If
    Next
    ' logout
    SAClient.Logout
End Sub
Function isUserExist(ByVal user As String)
    Dim bResult As Boolean
    On Error GoTo err
    If Len(SAClient.getUser(user)) < 1 Then
        ' no user
        bResult = False
    Else
        bResult = True
    End If
    isUserExist = bResult
    Exit Function
err:
    Debug.Print "ERROR: " + err.description
    isUserExist = False
End Function
Function isProjectExist(ByVal project As String, _
                ByVal domain As String)
    Dim bResult As Boolean
    On Error GoTo err
    If Len(SAClient.GetProject(domain, project)) < 1 Then
        ' no user
        bResult = False
    Else
        bResult = True
    End If
    isProjectExist = bResult
    Exit Function
err:
    Debug.Print "ERROR: " + err.description
    isProjectExist = False
End Function
Sub ProcessAll()
    ProcessUsers
    ProcessProjects
    ProcessGroups
End Sub

No comments:

Post a Comment