Content Supported by Sourcelens Consulting
VERSION 5.00
Begin VB.Form frmNewUserGroup
BorderStyle = 3 'Fixed Dialog
Caption = "New User Group"
ClientHeight = 1935
ClientLeft = 3990
ClientTop = 3525
ClientWidth = 3480
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
HelpContextID = 2016137
Icon = "NEWUG.frx":0000
KeyPreview = -1 'True
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 1935
ScaleWidth = 3480
ShowInTaskbar = 0 'False
StartUpPosition = 1 'CenterOwner
Begin VB.CommandButton cmdCancel
Cancel = -1 'True
Caption = "&Cancel"
Default = -1 'True
Height = 375
Left = 1800
MaskColor = &H00000000&
TabIndex = 5
Top = 1440
Width = 1455
End
Begin VB.CommandButton cmdOK
Caption = "&OK"
Enabled = 0 'False
Height = 375
Left = 240
MaskColor = &H00000000&
TabIndex = 4
Top = 1440
Width = 1455
End
Begin VB.TextBox txtPID
Height = 285
Left = 120
MaxLength = 20
TabIndex = 3
Top = 960
Width = 3255
End
Begin VB.TextBox txtName
Height = 285
Left = 120
TabIndex = 1
Top = 360
Width = 3255
End
Begin VB.Label lblLabels
AutoSize = -1 'True
Caption = "PID:"
Height = 195
Index = 1
Left = 120
TabIndex = 2
Top = 720
Width = 315
End
Begin VB.Label lblLabels
AutoSize = -1 'True
Caption = "Name:"
Height = 195
Index = 0
Left = 120
TabIndex = 0
Top = 120
Width = 465
End
End
Attribute VB_Name = "frmNewUserGroup"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'>>>>>>>>>>>>>>>>>>>>>>>>
Const BUTTON1 = "&OK"
Const BUTTON2 = "&Cancel"
Const Label1 = "&Name:"
Const Label2 = "&PID:"
Const MSG1 = "PID must be between 4 and 20 characters!"
'>>>>>>>>>>>>>>>>>>>>>>>>
Public UserOrGroup As Integer
Private Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub cmdOK_Click()
On Error GoTo OKErr
Dim sTmp As String
Dim usr As User
Dim grp As Group
If Len(txtPID) < 4 Then
Beep
MsgBox MSG1, 48
Exit Sub
End If
If UserOrGroup = 0 Then
Set usr = gwsMainWS.CreateUser(txtName.Text, txtPID.Text)
gwsMainWS.Users.Append usr
gwsMainWS.Groups.Refresh
frmGroupsUsers.lstUsers.AddItem txtName.Text
frmGroupsUsers.lstGroupsUsers.AddItem txtName.Text
'add the new user to the Users group by default
On Error Resume Next 'just in case the users group is gone
gwsMainWS.Groups("Users").Users.Append usr
gwsMainWS.Users(txtName.Text).Groups.Refresh
Else
Set grp = gwsMainWS.CreateGroup(txtName.Text, txtPID.Text)
gwsMainWS.Groups.Append grp
gwsMainWS.Users.Refresh
frmGroupsUsers.lstGroups.AddItem txtName.Text
frmGroupsUsers.lstUsersGroups.AddItem txtName.Text
End If
Unload Me
Exit Sub
OKErr:
ShowError
End Sub
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyF1 And Shift = 0 Then
DisplayTopic 2016137
End If
End Sub
Private Sub Form_Load()
cmdOK.Caption = BUTTON1
cmdCancel.Caption = BUTTON2
lblLabels(0).Caption = Label1
lblLabels(1).Caption = Label2
End Sub
Private Sub txtName_Change()
cmdOK.Enabled = Len(txtName.Text) > 0
End Sub