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