'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.
        '"BO_sR&ai>xc%ZwE_UdVe~9^DPBp1m" is used like a Password to safeguard the ExecSQLAzureSQL Procedure.
        If ExecSQLAzureSQL(strSQL, "BO_sR&ai>xc%ZwE_UdVe~9^DPBp1m") = 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, "X~K<2%fM>Tn5ejxJ$R&ZEyUzh")
        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. '*Update: To provide better security we have added an Argument to this Procedure to use like a 'Password as we did in the obfuscatedFunctionName Procedure. ' Public Function ExecSQLAzureSQL(strSQL As String, strIn As String) As Boolean On Error GoTo ErrHandle Dim db As DAO.DATABASE Dim qdf As DAO.QueryDef ExecSQLAzureSQL = False 'Default Value. 'This line ensures the code only runs if the "Password" Argument "strIn" is correct. If strIn = "BO_sR&ai>xc%ZwE_UdVe~9^DPBp1m" Then 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 obfuscatedFunctionName to a different 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 End If 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 11.0};" _ & "SERVER=tcp:MyServerName.database.windows.net,1433;" _ & "UID=MyUserName@MyServerName;" _ & "PWD=MyPassword;" _ & "DATABASE=MySQLAzureDatabaseName;" _ & "Encrypt=Yes" Else obfuscatedFunctionName = vbNullString End If End Function
'*Update: To provide better security we have added an Argument to this Procedure to use like a 'Password as we did in the ExecSQLAzureSQL and obfuscatedFunctionName Procedures. ' Public Function AddUserToSQLRole( _ strRole As String, _ strUser As String, _ strIn As String _ ) As Boolean Dim strSQL As String AddUserToSQLRole = False 'Default Value 'This line ensures the code only runs if the "Password" Argument "strIn" is correct. If strIn = "X~K<2%fM>Tn5ejxJ$R&ZEyUzh" Then '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, "BO_sR&ai>xc%ZwE_UdVe~9^DPBp1m") = 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 If End Function