Adding Windows username in a new record? (1 Viewer)

F

funwithaccess

Registered User.
Local time
Today, 10:42
Joined
Sep 5, 2013
Messages
80
Hi,

I am having a difficult time figuring out how to have a table add a new record that includes the Windows username of the user that clicks the button on my form. The function is in place that pulls the Windows username:

Code: 
Public Function getWinUser() As String

    getWinUser = Environ("UserName")

End Function

I then call the function during the button click by simply adding getWinUser. Unfortunately, all that occurs is that the same record gets updated instead of creating a new record.

Any advice?

Nate
 
Can't you use an append query?
 
Hi JHB,

I created the append query, is there anything that I need to add VBA wise? The table is not updating.
 
Are you calling the Query in the button event?

DoCmd.RunQuery "QueryName"
 
A little bit clear with the description would help us to help you.. Do you have a Form, which has a button to create New record in another table? Or you have a Form on creation of New record to the table it is bound to you need to 'log' that entry? Or what is that you want to do?
 
We want to track how often people are using the form. The form is setup like a search page and has a button that runs the queries for what they want to find. This is the same button that I want to call the functions: getWinUser & getDateTime. This is the code for the button, I'm not sure how to have it open the query and call the functions.

Code: 
Private Sub cmdFind_Click()
On Error GoTo cmdFind_Click_Err

  Dim qry As DAO.QueryDef
  Dim intCount As Integer
    
    Combo99.Value = ""
    Combo89.Value = ""
    Combo71.Value = ""
    Combo55.Value = ""
    Combo85.Value = ""
    Combo212.Value = ""
    
    For Each qry In CurrentDb.QueryDefs
    On Error Resume Next
        DoCmd.Close acQuery, qry.Name, acSaveYes
    Next
    
    intCount = 0
    
    If DCount("Location", "Phone numbers Query") > 0 Then
        intCount = intCount + 1
        DoCmd.OpenQuery "", acViewNormal, acReadOnly
    End If
    
    If DCount("Alias", "SD Documentation Query") > 0 Then
        intCount = intCount + 1
        DoCmd.OpenQuery "SD Documentation Query", acViewNormal, acReadOnly
    End If
    
    If DCount("Searchable Alias", "Info Gathering Query") > 0 Then
        intCount = intCount + 1
        DoCmd.OpenQuery "SD Documentation Query", acViewNormal, acReadOnly
    End If

    If DCount("AssetNumber", "Xerox Assets Query") > 0 Then
        intCount = intCount + 1
        DoCmd.OpenQuery "Xerox Assets Query", acViewNormal, acReadOnly
    End If

    If DCount("[IP Address]", "Xerox IP Query") > 0 Then
        intCount = intCount + 1
        DoCmd.OpenQuery "Xerox IP Query", acViewNormal, acReadOnly
    End If

    If DCount("SerialNumber", "Xerox Serial Query") > 0 Then
        intCount = intCount + 1
        DoCmd.OpenQuery "Xerox Serial Query", acViewNormal, acReadOnly
    End If

    If intCount = 0 Then MsgBox "No results found in ServiceBase." & vbCrLf & "Please provide a specific word, phrase, or alias.", vbExclamation + vbOKOnly, "ServiceBase Search Results"
        
       
cmdFind_Click_Exit:
    Exit Sub

cmdFind_Click_Err:
    MsgBox Error$
    Resume cmdFind_Click_Exit

End Sub

Everything else works the way that it should. The table is named "Usage Log" and the query is named "UL Query".

These are the functions:

Code: 
Public Function getWinUser() As String

    getWinUser = Environ("UserName")

End Function


Public Function getDateTime()
    
    Me.textDate = Date
    Me.textTime = Time()
    
End Function
 
So everytime a User uses the form (i.e. clicks the Run Search button) you want to record this in the Usage Log table? Is that correct? If yes, continue reading.. If no, explain how your tables/forms are set up..

So, what you need is an APPEND Query.. Something to Insert values into the Usage Log table.. The code you have is quiet not right, unless the Form is bound to the table.. As Me. would render useless outside a (bound) Forms..

The following code should do this for you..
Code: 
Private Sub cmdFind_Click()
On Error GoTo cmdFind_Click_Err

    Dim [COLOR=Blue][B]tmpDB As DAO.Database[/B][/COLOR], qry As DAO.QueryDef
    Dim intCount As Integer
    
   [COLOR=Blue][B] Set tmpDB = CurrentDB[/B][/COLOR]
    
    Combo99.Value = ""
    Combo89.Value = ""
    Combo71.Value = ""
    Combo55.Value = ""
    Combo85.Value = ""
    Combo212.Value = ""
    
    For Each qry In CurrentDb.QueryDefs
    On Error Resume Next
        DoCmd.Close acQuery, qry.Name, acSaveYes
    Next
    
    intCount = 0
    
    If DCount("Location", "Phone numbers Query") > 0 Then
        intCount = intCount + 1
        DoCmd.OpenQuery "", acViewNormal, acReadOnly
    End If
    
    If DCount("Alias", "SD Documentation Query") > 0 Then
        intCount = intCount + 1
        DoCmd.OpenQuery "SD Documentation Query", acViewNormal, acReadOnly
    End If
    
    If DCount("Searchable Alias", "Info Gathering Query") > 0 Then
        intCount = intCount + 1
        DoCmd.OpenQuery "SD Documentation Query", acViewNormal, acReadOnly
    End If

    If DCount("AssetNumber", "Xerox Assets Query") > 0 Then
        intCount = intCount + 1
        DoCmd.OpenQuery "Xerox Assets Query", acViewNormal, acReadOnly
    End If

    If DCount("[IP Address]", "Xerox IP Query") > 0 Then
        intCount = intCount + 1
        DoCmd.OpenQuery "Xerox IP Query", acViewNormal, acReadOnly
    End If

    If DCount("SerialNumber", "Xerox Serial Query") > 0 Then
        intCount = intCount + 1
        DoCmd.OpenQuery "Xerox Serial Query", acViewNormal, acReadOnly
    End If

    If intCount = 0 Then MsgBox "No results found in ServiceBase." & vbCrLf & "Please provide a specific word, phrase, or alias.", vbExclamation + vbOKOnly, "ServiceBase Search Results"
        
    [COLOR=Blue][B]tmpDB.Execute "INSERT INTO [UsageLog]([COLOR=Red]reportingUserFieldName[/COLOR], [COLOR=Red]reportingDateFieldName[/COLOR]) VALUES(" & Chr(34) & getWinUser() & Chr(34) & ", " & CDbl(Now) & ")"[/B][/COLOR]
cmdFind_Click_Exit:
    tmpDB = Nothing
    Exit Sub

cmdFind_Click_Err:
    MsgBox Error$
    Resume cmdFind_Click_Exit
End Sub
 
Yes, that is exactly what I am trying to do. I have the append query and the table. Unfortunately, nothing is occurring when the button is clicked. Here is the updated code:

Code: 
Private Sub cmdFind_Click()
On Error GoTo cmdFind_Click_Err

    Dim tmpDB As DAO.Database, qry As DAO.QueryDef
    Dim intCount As Integer
    
    Set tmpDB = CurrentDb
    
    Combo99.Value = ""
    Combo89.Value = ""
    Combo71.Value = ""
    Combo55.Value = ""
    Combo85.Value = ""
    Combo212.Value = ""
    
    Dim qry As DAO.QueryDef
    For Each qry In CurrentDb.QueryDefs
    On Error Resume Next
        DoCmd.Close acQuery, qry.Name, acSaveYes
    Next
    
    intCount = 0
    
    If DCount("Location", "Phone numbers Query") > 0 Then
        intCount = intCount + 1
        DoCmd.OpenQuery "", acViewNormal, acReadOnly
    End If
    
    If DCount("Alias", "SD Documentation Query") > 0 Then
        intCount = intCount + 1
        DoCmd.OpenQuery "SD Documentation Query", acViewNormal, acReadOnly
    End If
    
    If DCount("Searchable Alias", "Info Gathering Query") > 0 Then
        intCount = intCount + 1
        DoCmd.OpenQuery "SD Documentation Query", acViewNormal, acReadOnly
    End If

    If DCount("AssetNumber", "Xerox Assets Query") > 0 Then
        intCount = intCount + 1
        DoCmd.OpenQuery "Xerox Assets Query", acViewNormal, acReadOnly
    End If

    If DCount("[IP Address]", "Xerox IP Query") > 0 Then
        intCount = intCount + 1
        DoCmd.OpenQuery "Xerox IP Query", acViewNormal, acReadOnly
    End If

    If DCount("SerialNumber", "Xerox Serial Query") > 0 Then
        intCount = intCount + 1
        DoCmd.OpenQuery "Xerox Serial Query", acViewNormal, acReadOnly
    End If

    If intCount = 0 Then MsgBox "No results found in ServiceBase." & vbCrLf & "Please provide a specific word, phrase, or alias.", vbExclamation + vbOKOnly, "ServiceBase Search Results"
        
    tmpDB.Execute "INSERT INTO [Usage Log](NT ID, loginDate) VALUES(" & Chr(34) & getWinUser() & Chr(34) & ", " & CDbl(Now) & ")"

cmdFind_Click_Exit:
    tmpDB = Nothing
    Exit Sub

cmdFind_Click_Err:
    MsgBox Error$
    Resume cmdFind_Click_Exit
End Sub

Thank you for assisting me!
 
If you have spaces in the field/table names surround them with square brackets.. Like.. [NT ID]

A very important advice, do not use On Error Resume Next until you exactly know why you would avoid the error.. With that statement you will fail to understand the actual error.. In this case the Execute statement is never run..

Use a proper Error handler..
 
I added the brackets accordingly, unfortunately nothing happens. I really appreciate all of your help so far!
 
This is the updated code:

Code: 
Private Sub cmdFind_Click()
On Error GoTo cmdFind_Click_Err

    Dim tmpDB As DAO.Database, qry As DAO.QueryDef
    Dim intCount As Integer
    
    Set tmpDB = CurrentDb
    
    Combo99.Value = ""
    Combo89.Value = ""
    Combo71.Value = ""
    Combo55.Value = ""
    Combo85.Value = ""
    Combo212.Value = ""
    
    For Each qry In CurrentDb.QueryDefs
        DoCmd.Close acQuery, qry.Name, acSaveYes
    Next
    
    intCount = 0
    
    If DCount("Location", "Phone numbers Query") > 0 Then
        intCount = intCount + 1
        DoCmd.OpenQuery "", acViewNormal, acReadOnly
    End If
    
    If DCount("Alias", "SD Documentation Query") > 0 Then
        intCount = intCount + 1
        DoCmd.OpenQuery "SD Documentation Query", acViewNormal, acReadOnly
    End If
    
    If DCount("Searchable Alias", "Info Gathering Query") > 0 Then
        intCount = intCount + 1
        DoCmd.OpenQuery "SD Documentation Query", acViewNormal, acReadOnly
    End If

    If DCount("AssetNumber", "Xerox Assets Query") > 0 Then
        intCount = intCount + 1
        DoCmd.OpenQuery "Xerox Assets Query", acViewNormal, acReadOnly
    End If

    If DCount("[IP Address]", "Xerox IP Query") > 0 Then
        intCount = intCount + 1
        DoCmd.OpenQuery "Xerox IP Query", acViewNormal, acReadOnly
    End If

    If DCount("SerialNumber", "Xerox Serial Query") > 0 Then
        intCount = intCount + 1
        DoCmd.OpenQuery "Xerox Serial Query", acViewNormal, acReadOnly
    End If

    If intCount = 0 Then MsgBox "No results found in ServiceBase." & vbCrLf & "Please provide a specific word, phrase, or alias.", vbExclamation + vbOKOnly, "ServiceBase Search Results"
        
    tmpDB.Execute "INSERT INTO [Usage Log]([NT ID], loginDate) VALUES(" & Chr(34) & getWinUser() & Chr(34) & ", " & CDbl(Now) & ")"

cmdFind_Click_Exit:
    tmpDB = Nothing
    Exit Sub

cmdFind_Click_Err:
    MsgBox Error$
    Resume cmdFind_Click_Exit
End Sub
 
Are you sure the procedure is running when the button clicked?

Put a break point after the record had been added to the log table and in the immediate window, type
? tmpdb.recordsaffected

It should be a value of 1
 
A little background:

This is to clear any textboxes:
Code: 
Combo99.Value = ""
    Combo89.Value = ""
    Combo71.Value = ""
    Combo55.Value = ""
    Combo85.Value = ""
    Combo212.Value = ""

This is to close any open queries so that the new queries can be ran:
Code: 
For Each qry In CurrentDb.QueryDefs
        DoCmd.Close acQuery, qry.Name, acSaveYes
    Next
The int count is so that unnecessary queries do not open as a tab:
Code: 
Dim intCount As Integer
For Each qry In CurrentDb.QueryDefs
        DoCmd.Close acQuery, qry.Name, acSaveYes
    Next
    
    intCount = 0
    
    If DCount("Location", "Phone numbers Query") > 0 Then
        intCount = intCount + 1
        DoCmd.OpenQuery "", acViewNormal, acReadOnly
    End If
    
    If DCount("Alias", "SD Documentation Query") > 0 Then
        intCount = intCount + 1
        DoCmd.OpenQuery "SD Documentation Query", acViewNormal, acReadOnly
    End If
    
    If DCount("Searchable Alias", "Info Gathering Query") > 0 Then
        intCount = intCount + 1
        DoCmd.OpenQuery "SD Documentation Query", acViewNormal, acReadOnly
    End If

    If DCount("AssetNumber", "Xerox Assets Query") > 0 Then
        intCount = intCount + 1
        DoCmd.OpenQuery "Xerox Assets Query", acViewNormal, acReadOnly
    End If

    If DCount("[IP Address]", "Xerox IP Query") > 0 Then
        intCount = intCount + 1
        DoCmd.OpenQuery "Xerox IP Query", acViewNormal, acReadOnly
    End If

    If DCount("SerialNumber", "Xerox Serial Query") > 0 Then
        intCount = intCount + 1
        DoCmd.OpenQuery "Xerox Serial Query", acViewNormal, acReadOnly
    End If

    If intCount = 0 Then MsgBox "No results found in ServiceBase." & vbCrLf & "Please provide a specific word, phrase, or alias.", vbExclamation + vbOKOnly, "ServiceBase Search Results"

Most likely you all already know that. :) However, I figured that it might help.
 
Paul,

I set the form to unbound and no longer use the Me. for the date and time. Not sure if that will help my situation at all. The new functions for date and time:
Code: 
Public Function getTime()

    getTime = Format(Now(), "h:m:s")
    
End Function

Public Function getDate()

    getDate = Format(Date, "mm/dd/yyyy")
    
End Function
 
The functions are not set to return proper datatypes.. Change that.. Also you do not need functions.. You can directly use them in your Queries.. That's all that you need..

Anyway.. As Cronk suggested, try setting breakpoint..

attachment.php
 
Date and Now are Functions.

Why would you write a function to call a Function. Simply not Required.
 
Code: 
 Combo99.Value = ""
    Combo89.Value = ""
    Combo71.Value = ""
    Combo55.Value = ""
    Combo85.Value = ""
    Combo212.Value = ""

What does this do. I can't see how it fits in.
 
Hi Nate,

To get user name use the code below instead of "Environ"

Declare following api

Code: 
Private Declare PtrSafe Function apiGetUserName Lib "advapi32.dll" Alias _
    "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Code: 
    'Purpose:   Returns the network login name
    'Return:    The name, or "{Unknown}" on error.
    'Note:      Safer than testing Environ().
    Dim lngLen As Long
    Dim lngX As Long
    Dim strUserName As String
    
    strUserName = String$(254, 0&)
    lngLen = 255&
    lngX = apiGetUserName(strUserName, lngLen)
    If (lngX > 0&) Then
        strUserName = Left$(strUserName, lngLen - 1&)
    End If
    
    If strUserName <> vbNullString Then
        GetNetworkUserName = strUserName
    Else
        GetNetworkUserName = "{unknown}"
    End If

It's safer,

PS: If you run your access on 32 bit, just delete "ptrsafe" on the api.

Regards,

Contractor
 
pr2-eugin said:
The functions are not set to return proper datatypes.. Change that.. Also you do not need functions.. You can directly use them in your Queries.. That's all that you need..

Anyway.. As Cronk suggested, try setting breakpoint..

attachment.php
Click to expand...

Paul, where exactly do I add the breakpoint? At the tmpDB.Execute line?

What does this do. I can't see how it fits in.
Click to expand...
It clears all of textboxes on the form when the "cmdFind" button is clicked (this was a decision by my management).

Hi Nate,

To get user name use the code below instead of "Environ"

Declare following api

Code:
Private Declare PtrSafe Function apiGetUserName Lib "advapi32.dll" Alias _
"GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Code:
'Purpose: Returns the network login name
'Return: The name, or "{Unknown}" on error.
'Note: Safer than testing Environ().
Dim lngLen As Long
Dim lngX As Long
Dim strUserName As String

strUserName = String$(254, 0&)
lngLen = 255&
lngX = apiGetUserName(strUserName, lngLen)
If (lngX > 0&) Then
strUserName = Left$(strUserName, lngLen - 1&)
End If

If strUserName <> vbNullString Then
GetNetworkUserName = strUserName
Else
GetNetworkUserName = "{unknown}"
End If
It's safer,

PS: If you run your access on 32 bit, just delete "ptrsafe" on the api.

Regards,

Contractor
Click to expand...
Thanks for this, Contractor! I can't get this to work. I keep getting an error that comments need to be added after end sub, end function, and end property. Any idea how to get around that?

Thank you all for your help!! This task is outside of my ability, as you have probably already figured that out. :banghead:
 
You must log in or register to reply here.

Similar threads

S
Solved Create new child record with modal dialog?
Replies
11
Views
1,680
Sheridan
S
A
“Add A New Record” function is not working
Replies
12
Views
986
access2010
A
A
The copy text and add new record Button Events are not working
2
Replies
31
Views
2,396
arnelgp
arnelgp
I
Solved Error about assigning Null value when clicking away from deleted form field
Replies
16
Views
816
BlueSpruce
BlueSpruce
J
Solved Form reload error ole and activex
Replies
7
Views
1,027
AHeyne
A

Users who are viewing this thread

Total: 2 (members: 0, guests: 2)
Back
Top Bottom