Class
Option Explicit
Private mstrUserAccount As String
Private mstrGroups As String
Private mstrDomain As String

'********************************************
Private Function GetUserGroup() As Long

'use ADSI to query for group membership

Dim objGroup As IADsGroup
Dim strGroups(4) As String
Dim i As Integer

On Error GoTo GetUserGroupErr

'load the array of groups to look through
strGroups(2) = "Western"
strGroups(4) = "Southern"
strGroups(1) = "Eastern"
strGroups(3) = "Northern"

'loop through each group and check for membership
For i = 1 To UBound(strGroups)
   'get a reference to the group
   Set objGroup = GetObject("WinNT://" & _
      mstrDomain & "/" & strGroups(i))
   'check if the user is a member
   If objGroup.IsMember("WinNT://" & _
      mstrDomain & "/" & mstrUserAccount) Then
      'return the ID of the group
      GetUserGroup = i
      Exit Function
   End If
Next

GetUserGroup = 0
Set objGroup = Nothing
Exit Function
GetUserGroupErr:
   GetUserGroup = 0
   Err.Raise vbObjectError + 1024, _
      "GetUserGroup", Err.Description
    
End Function

'********************************************
Public Function ListOrders() As ADODB.Recordset
'use ADO 2.0 to call the stored proc to return 'the rows
'pass in the group memberships

Dim lRegionID As Long
Dim lcmCommand As ADODB.Command
Dim lparParam As ADODB.Parameter
Dim lcnConnection As ADODB.Connection

On Error GoTo ListOrdersErr

Set lcnConnection = New ADODB.Connection
lcnConnection.ConnectionString = _
   "DRIVER={SQLServer};SERVER=SSOSA;" & _ 
   "DATABASE=Northwind;UID=sa;PWD="
lcnConnection.CursorLocation = adUseClient
lcnConnection.Open

lRegionID = GetUserGroup

Set lcmCommand = New ADODB.Command
lcmCommand.CommandText = "GetOrders"
lcmCommand.CommandType = adCmdStoredProc
Set lparParam = _
   lcmCommand.CreateParameter("@regionid", _
   adInteger, adParamInput, 4, lRegionID)
lcmCommand.Parameters.Append lparParam
Set lcmCommand.ActiveConnection = _
   lcnConnection

Set ListOrders = lcmCommand.Execute

Set lcnConnection = Nothing
Set lcmCommand = Nothing

Exit Function
ListOrdersErr:
   Set ListOrders = Nothing
   Set lcmCommand = Nothing
   Set lcnConnection = Nothing
   Err.Raise vbObjectError + 50, _
      "ListOrders", Err.Description

End Function

'********************************************
Public Property Get UserAccount() As String
   UserAccount = mstrUserAccount
End Property

'********************************************
Public Property Let UserAccount(ByVal vNewValue _
   As String)
       mstrUserAccount = vNewValue
End Property

'********************************************
Public Property Get UserDomain() As String
   Username = mstrDomain
End Property

'********************************************
Public Property Let UserDomain(ByVal vNewValue As _
   String)
   mstrDomain = vNewValue
End Property