'Code from article Using Microsoft Access to Manage SQL Azure Database Users and Roles

'***************************************************************************************
'Procedure to be used in a Form to Create SQL Azure Database Roles
'***************************************************************************************
'
Private Sub cmdCreateRole_Click()

    Dim strSQL As String

    'Verify a Role name has been entered.
    If Len(Me.txtNewRole & vbNullString) = 0 Then
        MsgBox "Please enter a name for the new Role.", vbCritical
    Else
        'Create the T-SQL to be passed to SQL Azure.
        strSQL = "CREATE ROLE " & Me.txtNewRole

        'Create the new Role.
        If ExecSQLAzureSQL(strSQL) = False Then
            MsgBox "The Role was not created. Please try again.", vbCritical
        Else
            MsgBox "The Role """ & Me.txtNewRole & """ was created.", vbInformation
        End If
    End If

End Sub

---

'***************************************************************************************
'Procedure to be used in a Form to add SQL Azure Users to Database Roles
'***************************************************************************************
'
Private Sub cmdAddUserToRole_Click()

    Dim strRole As String
    Dim strUser As String

    'Verify a Role name has been entered.
    If Len(Me.txtRoleName & vbNullString) = 0 Then
        MsgBox "Please enter a name for the Role.", vbCritical
    Else
        strRole = Me.txtRoleName

        'Verify a User name has been entered.
        If Len(Me.txtUserName & vbNullString) = 0 Then
            MsgBox "Please enter a name for the User.", vbCritical
        Else
            strUser = Me.txtUserName

            'Now that we have both a Role and a User Name we
            'can call a Function to add the User to the Role.
            Call AddUserToSQLRole(strRole, strUser)
        End If
    End If


End Sub

---

'***************************************************************************************
'All Procedures below should be placed in a Standard Module
'***************************************************************************************

'Public Function ExecSQLAzureSQL
'Place this Procedure in a Standard Module.
'Executes the SQL using a Pass-through Query.
'The SQL is executed in the SQL Azure database in the connection string.
'This procedure is for "Action Queries" SQL that does not return records.
'
Public Function ExecSQLAzureSQL(strSQL As String) As Boolean
On Error GoTo ErrHandle

    Dim db As DAO.Database
    Dim qdf As DAO.QueryDef

    ExecSQLAzureSQL = False 'Default Value

    Set db = CurrentDb

    'Create a temporary unnamed Pass-through QueryDef. This is a
    'practice recommended in the Microsoft Developer Reference.
    'The order of each line of code must not be changed or the code will fail.
    Set qdf = db.CreateQueryDef("")

    'Use a function that returns the Connection string to the SQL Azure database.
    'Change the obfuscatedFunctionName's name for Security.
    qdf.Connect = obfuscatedFunctionName("Wb_gR%/PD\-k&yZq~j>l")

    'Set the QueryDef's SQL as the strSQL passed in to the procedure.
    qdf.SQL = strSQL

    'ReturnsRecords must be set to False if the SQL does not return records.
    qdf.ReturnsRecords = False

    'Execute the Pass-through query.
    qdf.Execute dbFailOnError

    'If no errors were raised the query was successfully executed.
    ExecSQLAzureSQL = True

ExitHere:
    'Cleanup for security and to release memory
    On Error Resume Next
    Set qdf = Nothing
    Set db = Nothing
    Exit Function

ErrHandle:
    MsgBox "Error " & Err.Number & vbCrLf & Err.Description _
    & vbCrLf & "In procedure ExecSQLAzureSQL"
    Resume ExitHere

End Function

---

'It is best to change the name of this procedure for better security for your use.
'The strIn Argument value, "Wb_gR%/PD\-k&yZq~j>l", is used like a Password to keep
'unauthorized users from getting your Connection String. You should also change it
'to suit you before you use it in a distributed application.
Public Function obfuscatedFunctionName(strIn As String) As String
    If strIn = "Wb_gR%/PD\-k&yZq~j>l" Then
        obfuscatedFunctionName = "ODBC;" _
            & "DRIVER={SQL Server Native Client 10.0};" _
            & "SERVER=tcp:MyServerName.database.windows.net,1433;" _
            & "UID=MyUserName@MyServerName;" _
            & "PWD=MyPassword;" _
            & "DATABASE=MySQLAzureDatabaseName;" _
            & "Encrypt=Yes"
    Else
        obfuscatedFunctionName = vbNullString
    End If
End Function

---

Function AddUserToSQLRole(strRole As String, strUser As String) As Boolean

    Dim strSQL As String

    AddUserToSQLRole = False 'Default Value

    'Build the T-SQL that will add the User to the Role.
    strSQL = "EXEC sp_addrolemember '" & strRole & "', '" & strUser & "';"

    'Call the Function to execute the SQL.
    If ExecSQLAzureSQL(strSQL) = True Then
        AddUserToSQLRole = True

        'Inform the User of Success
        MsgBox "User """ & strUser & """ was added to the """ _
            & strRole & """ Role.", vbInformation
    Else
        'Inform the User of Failure.
        MsgBox "User """ & strUser & """ was NOT added to the """ _
            & strRole & """ Role." & vbCrLf & vbCrLf _
            & Space(30) & "Please try again.", vbCritical
    End If

End Function