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

F

funwithaccess

Registered User.
Local time
Today, 15:09
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
 
J

JHB

Have been here a while
Local time
Today, 21:09
Joined
Jun 17, 2012
Messages
7,732
Can't you use an append query?
 
F

funwithaccess

Registered User.
Local time
Today, 15:09
Joined
Sep 5, 2013
Messages
80
Hi JHB,

I created the append query, is there anything that I need to add VBA wise? The table is not updating.
 
A

AlexHedley

Registered User.
Local time
Today, 20:09
Joined
Aug 28, 2012
Messages
171
Are you calling the Query in the button event?

DoCmd.RunQuery "QueryName"
 
pr2-eugin

pr2-eugin

Super Moderator
Local time
Today, 20:09
Joined
Nov 30, 2011
Messages
8,494
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?
 
F

funwithaccess

Registered User.
Local time
Today, 15:09
Joined
Sep 5, 2013
Messages
80
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
 
pr2-eugin

pr2-eugin

Super Moderator
Local time
Today, 20:09
Joined
Nov 30, 2011
Messages
8,494
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
 
F

funwithaccess

Registered User.
Local time
Today, 15:09
Joined
Sep 5, 2013
Messages
80
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!
 
pr2-eugin

pr2-eugin

Super Moderator
Local time
Today, 20:09
Joined
Nov 30, 2011
Messages
8,494
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..
 
F

funwithaccess

Registered User.
Local time
Today, 15:09
Joined
Sep 5, 2013
Messages
80
I added the brackets accordingly, unfortunately nothing happens. I really appreciate all of your help so far!
 
F

funwithaccess

Registered User.
Local time
Today, 15:09
Joined
Sep 5, 2013
Messages
80
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
 
Cronk

Cronk

Registered User.
Local time
Tomorrow, 05:09
Joined
Jul 4, 2013
Messages
2,774
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
 
F

funwithaccess

Registered User.
Local time
Today, 15:09
Joined
Sep 5, 2013
Messages
80
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.
 
F

funwithaccess

Registered User.
Local time
Today, 15:09
Joined
Sep 5, 2013
Messages
80
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
 
pr2-eugin

pr2-eugin

Super Moderator
Local time
Today, 20:09
Joined
Nov 30, 2011
Messages
8,494
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..

 
RainLover

RainLover

VIP From a land downunder
Local time
Tomorrow, 05:09
Joined
Jan 5, 2009
Messages
5,041
Date and Now are Functions.

Why would you write a function to call a Function. Simply not Required.
 
RainLover

RainLover

VIP From a land downunder
Local time
Tomorrow, 05:09
Joined
Jan 5, 2009
Messages
5,041
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.
 
C

contractor

Having Fun With Access
Local time
Today, 12:09
Joined
Apr 12, 2012
Messages
47
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
 
F

funwithaccess

Registered User.
Local time
Today, 15:09
Joined
Sep 5, 2013
Messages
80
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..

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

T
Solved nagivation control. where clause = new record
2
Replies
25
Views
533
theDBguy
theDBguy
J
Followhyperlink alternate
Replies
8
Views
326
John Sh
J
R
Win32: hWnd for Continuous Forms Detail Section(s)?
Replies
9
Views
516
riktek
R
G
New vs old buttons on a form
Replies
5
Views
526
Pat Hartman
P
M
Hide default Add New Record Button ONLY - How?
2 3
Replies
47
Views
1,276
Marshall Brooks
M

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Top Bottom