alex said:
Hello,
I have a function that returns a UserID; call it function A().
I’d like to have another function that compares function A against a
value in a table.
Something like…
Public function B()
If value of function A = value in table field Then
do something
Else
do something else
End if
Exit function
I’ve tried several things, even DLookup; I can’t get it to work.
Thanks,
alex
A user asked me to change an unbound form designed for concurrent use
(such that last edit wins) into a form that can only be used by one
person at a time (one of two secretaries actually) in the quickest way
possible. The code is still rough and I have done very little testing
with it. Here is the result without explanation:
tblFormOccupied (Linked table)
FOID AutoNumber
FormName Text
UserUsingForm Text
FOID FormName UserUsingForm
1 frmShipperOrder Null
....
tblUserID (Linked table)
UIID AutoNumber
FullName Text
UserID Text
EmailPrefix Text
PhoneExt Text
UIID FullName UserID EmailPrefix PhoneExt
1 Jonathan Smith smith1030 jsmith 24
....
'-----Code behind Form_frmShipperOrder-----
Private Sub Form_Load()
....
If OccupySingleUserForm(CStr(Me.Name)) = False Then
strTitle = "If that user is not actually using " & Me.Name & "..."
strPrompt = "Click Yes to override the warning and take control of
the form anyway."
Response = MsgBox(strPrompt, vbYesNo, strTitle)
If Response <> vbYes Then
DoCmd.Close acForm, Me.Name
Exit Sub
Else
'Clear the table
Set MyDB = CurrentDb
strSQL = "UPDATE tblFormOccupied SET UserUsingForm = Null WHERE
FormName = " & Chr(34) & Me.Name & Chr(34) & ";"
MyDB.Execute strSQL, dbFailOnError
DoEvents
'Try again
boolX = OccupySingleUserForm(CStr(Me.Name))
Set MyDB = Nothing
End If
End If
....
Private Sub Form_Unload(Cancel As Integer)
Call UnoccupySingleUseForm(CStr(Me.Name))
End Sub
'-----End Code behind Form_frmShipperOrder-----
'-----Begin Module Code
Declare Function sGetUserName Lib "advapi32.dll" Alias "GetUserNameA" ( _
ByVal lpBuffer As String, _
ByRef nSize As Long) As Long
Public Function GetUserName() As String
Dim strName As String
Dim lngResult As Long
strName = String(100, 0)
lngResult = sGetUserName(strName, 100)
GetUserName = Left$(strName, InStr(1, strName, Chr$(0)) - 1)
End Function
Public Function OccupySingleUserForm(strFormName As String) As Boolean
Dim MyDB As DAO.Database
Dim strSQL As String
Dim MyRS As DAO.Recordset
Dim UIDRS As DAO.Recordset
Dim varUser As Variant
Dim strCurrentUserID As String
Dim strUser As String
Dim I As Integer
OccupySingleUserForm = False
strCurrentUserID = GetUserName()
For I = 1 To 200
DoEvents
Next I
DoEvents
strSQL = "SELECT UserUsingForm FROM tblFormOccupied WHERE FormName = " &
Chr(34) & strFormName & Chr(34) & ";"
Set MyDB = CurrentDb
Set MyRS = MyDB.OpenRecordset(strSQL, dbOpenDynaset)
If MyRS.RecordCount > 0 Then
MyRS.MoveFirst
varUser = MyRS("UserUsingForm")
'If IsNull(varUser) Then varUser = ""
Select Case Nz(varUser, "")
Case "":
MyRS.Edit
MyRS("UserUsingForm") = strCurrentUserID
MyRS.Update
'I want to close the recordset as soon as possible in this case so
the code to close the recordset is being placed in multiple places
MyRS.Close
Set MyRS = Nothing
OccupySingleUserForm = True
Case strCurrentUserID:
MyRS.Close
Set MyRS = Nothing
MsgBox ("You seem to be using " & strFormName & " already.")
Case Else
'The form is in use.
MyRS.Close
Set MyRS = Nothing
'Attempt to get the user name from tblUserID.
strSQL = "SELECT FullName FROM tblUserID WHERE UserID = " & Chr(34)
& varUser & Chr(34) & ";"
Set UIDRS = MyDB.OpenRecordset(strSQL, dbOpenSnapshot)
If UIDRS.RecordCount > 0 Then
UIDRS.MoveFirst
strUser = UIDRS("FullName")
Else
'If unsuccessful, give them at least the User's login
strUser = varUser
End If
UIDRS.Close
Set UIDRS = Nothing
MsgBox ("Form " & strFormName & " can only be used by one user at a
time. It is currently in use by: " & strUser)
End Select
End If
Set MyDB = Nothing
End Function
Public Sub UnoccupySingleUseForm(strFormName As String)
Dim MyDB As DAO.Database
Dim strSQL As String
Dim MyRS As DAO.Recordset
Dim strCurrentUserID As String
Dim I As Integer
strCurrentUserID = GetUserName()
For I = 1 To 200
DoEvents
Next I
strSQL = "SELECT UserUsingForm FROM tblFormOccupied WHERE FormName = " &
Chr(34) & strFormName & Chr(34) & ";"
Set MyDB = CurrentDb
Set MyRS = MyDB.OpenRecordset(strSQL, dbOpenDynaset)
If MyRS.RecordCount > 0 Then
MyRS.MoveFirst
If MyRS("UserUsingForm") = strCurrentUserID Then
'Clear out the UserUsingForm field for the given form
'MsgBox ("Making " & strFormName & " unoccupied. Please make sure
any other copies you have open of " & strFormName & " are closed.")
MyRS.Edit
MyRS("UserUsingForm") = Null
MyRS.Update
End If
End If
MyRS.Close
Set MyRS = Nothing
Set MyDB = Nothing
End Sub
'-----End Module Code
Perhaps it will help. Watch out for line wrap.
James A. Fortune
(e-mail address removed)
