More Adding VBA results to table

[puforee]

Andy (Andrzejek) and I have been working on an MS Access issue for about a week now. VBA code inspecting the .ldb file for the computer_name of who's on line. We have that part down. Now we need to insert the results into a table. We are using strSQL to do this and we keep coming up with a Syntax error. See the therad named Adding VBA results to table for a list of things we have tried. Here is the code:

Function ShowUserRosterMultipleUsers()
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim i, j As Long
Dim dbs As Database

Set cn = CurrentProject.Connection
Set rs = cn.OpenSchema(adSchemaProviderSpecific, _
, "{947bb102-5d43-11d1-bdbf-00c04fb92675}")

'Debug.Print rs.Fields(0).Name, "", rs.Fields(1).Name, _
'"", rs.Fields(2).Name, rs.Fields(3).Name

' Modify this line to include the path and name
' to your Access data base
Set dbs = OpenDatabase("C:\Documents and Settings\xjjs8542\Desktop\ED\DB\Working\Test ED Rev 1.X.mdb")

'While Not rs.EOF
'strSQL = "INSERT INTO Usertbl (ComputerName) " _
' & " VALUES('" & Trim(rs.Fields(0)) & "')"
'Debug.Print strSQL
'dbs.Execute strSQL 'Code fails here indicatgingstrSQL
syntax error
'rs.MoveNext
'Wend
Debug.Print rs.Fields(0)
dbs.Close

End Function

I have validate the Table Name and Field name to be spelled correctly...you can see where I indicated the Code Failure.

Can anyone help...please.

 

[jrbarnett]

Try putting a space between VALUES and the open bracket

If this doesn't work, uncomment the debug.print command and post it here.

John

 

[MazeWorX]

I don't see a ;semicolon closing your SQL

HTH << MaZeWorX >> "I have not failed I have only found ten thousand ways that don't work

 

[puforee]

OK I tried both: Not at the same time.

Jrbarnett. The space did not change the failure. And here is what the debug.print showed...
INSERT INTO Usertbl (ComputerName) VALUES ('A4826682 ')..and the value returned is correct except for an extra space after the 2.

MazeWorX: Here is where I put the semicolon: At the end.

strSQL = "INSERT INTO Usertbl (ComputerName) " _
& " VALUES ('" & Trim(rs.Fields(0)) & "')";

This turned the complete statement red. And "Help" did not help.

Question to both of you...this code should return A4826682 as text to be placed in the table. Note the DIM rs at the top...could this be causing a conflict?

 

[dhookom]

I would first change this line to be more explicit:

   Dim dbs As DAO.Database

I would add a breakpoint after this line and check to see if there is an LDB file created:

    Set dbs = OpenDatabase("C:\Documents and Settings\xjjs8542\Desktop\ED\DB\Working\Test ED Rev 1.X.mdb")

I don't care for two periods/dots in a file name. Have you tried this code with a different file?

Have you tried linking to Usertbl and running:

INSERT INTO Usertbl (ComputerName)  VALUES ('A4826682 ')

Duane
Hook'D on Access
MS Access MVP

 

[puforee]

dhookom,

Can you show me the complete code as you see it? I am a novice.

The overall objective is to read the .ldb file and find all the ComputerNames that are logged on. I can then compare those to my DB (another table) to set up access restrictions.

Actually I would desire to see the user names instead of the computer names...but I don'k know how to do that. User names would be like "xjjs8542" which is my userID.

 

[dhookom]

I don't know anything about the schema stuff but would try:

Function ShowUserRosterMultipleUsers()
    Dim cn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim strDBName as String
    Dim i, j As Long
    Dim dbs As DAO.Database

    Set cn = CurrentProject.Connection
    Set rs = cn.OpenSchema(adSchemaProviderSpecific, _
        , "{947bb102-5d43-11d1-bdbf-00c04fb92675}")
[green]    'get rid of one of the dots in the file name so its name is:[/green]
    strDBName = "C:\Documents and Settings\xjjs8542\Desktop\ED\DB\Working\Test ED Rev 1X.mdb"
    Debug.Print rs.Fields(0).Name, "", rs.Fields(1).Name, _
        "", rs.Fields(2).Name, rs.Fields(3).Name

[green]    ' Modify this line to include the path and name
    ' to your Access data base[/green]
    Set dbs = OpenDatabase(strDBName)

    While Not rs.EOF
        strSQL = "INSERT INTO Usertbl (ComputerName) " _
            & " VALUES ('" & Trim(rs.Fields(0)) & "')"
        Debug.Print strSQL
        dbs.Execute strSQL  'Code fails here indicatgingstrSQL
                              syntax error
        rs.MoveNext
    Wend
[green]    'Debug.Print rs.Fields(0)[/green]
    dbs.Close

End Function

Duane
Hook'D on Access
MS Access MVP

 

[MazeWorX]

Semicolon goes inside the quotes );"

HTH << MaZeWorX >> "I have not failed I have only found ten thousand ways that don't work

 

[puforee]

I get a message: Run time error 3024
Could not find file 'C:\Documents and Settings\xjjs8542\Desktop\ED\DB\Working\Test ED Rev 1X.mdb'

Because of spaces I changed the name to strDBName = "C:\Documents and Settings\xjjs8542\Desktop\ED\DB\Working\TestEDRev1X.mdb"

I get the same error..and, I copied in the link so there is no misspelling.

Does this work on your computer? Of course some of the names would have to be changed. But....

 

[puforee]

MazeWorx.

I did this. strSQL = "INSERT INTO Usertbl (ComputerName) " _
& " VALUES ('" & Trim(rs.Fields(0)) & "');"

And I am still getting this syntax error:
Syntax error in string in query ex[pression "A4826682'

 

[dhookom]

The semi-colon isn't needed.
If the file can't be found then we can't help you. It's an error on your part in determining the correct file name and location.

Once you correctly find the MDB file, try hard-code the value like:

strSQL = "INSERT INTO Usertbl ([ComputerName]) " _
        & " VALUES ('A4826682')"

Duane
Hook'D on Access
MS Access MVP

 

[puforee]

OK...let me go back to the original code that I got from the internet. The orginial did not include the DB name...because it is already open. It also only did Debug.prints and no SQL. That all worked. Then andy helped by including the SQL. So the original + SQL looks like this. I commented out the Debug.Prints

Function ShowUserRosterMultipleUsers2()
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim i, j As Long
Dim strSQL As String


Set cn = CurrentProject.Connection
Set rs = cn.OpenSchema(adSchemaProviderSpecific, _
, "{947bb102-5d43-11d1-bdbf-00c04fb92675}")

'Debug.Print rs.Fields(0).Name, "", rs.Fields(1).Name, _
"", rs.Fields(2).Name, rs.Fields(3).Name

While Not rs.EOF
strSQL = "INSERT INTO Usertbl (ComputerName) " _
& " VALUES ('" & Trim(rs.Fields(0)) & "')"
'Debug.Print strSQL
cn.Execute strSQL
rs.MoveNext
Wend
Debug.Print rs.Fields(0)
End Function


This is failing with the following statement:

Run-time error '-2147217900(80040e14)':
Syntax error in string in query expression "A4826682'.

Can you tell what is wrong with the syntax? Also, there could be more than one computer logged on to the db...should this capture all the computers logged on and store their computer names in the Usertbl?

 

[puforee]

Continuing on. I changed the code to this:

Function ShowUserRosterMultipleUsers()
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim i, j As Long
Dim rs0 As String
Dim rs1 As String
Dim rs2 As String
Dim rs3 As String


Set cn = CurrentProject.Connection

' The user roster is exposed as a provider-specific schema rowset
' in the Jet 4.0 OLE DB provider. You have to use a GUID to
' reference the schema, as provider-specific schemas are not
' listed in ADO's type library for schema rowsets

Set rs = cn.OpenSchema(adSchemaProviderSpecific, _
, "{947bb102-5d43-11d1-bdbf-00c04fb92675}")

'Output the list of all users in the current database.

While Not rs.EOF
DoCmd.RunSQL "INSERT INTO Usertbl([ComputerName]) VALUES ('rs.Fields(0)')"
'Debug.Print rs.Fields(0), rs.Fields(1),
'rs.Fields (2), rs.Fields(3)
rs.MoveNext

Wend


End Function

Note: I am unsing the DoCmd. Insert into code. This is working except the & Trim(rs.Fields(0) is what is being written into the table. I am missing how to callthe results of the RS.Fields (0) actual value. How do I change the VALUES statement to = the result of RS.

Can you help with this.

 

[MazeWorX]

If you want to write this data to a table why not open a second record set (the Usertbl table) and update the record set by looping through the first rs?

If rs.RecordCount = 0 Then
 Exit Function
Else
 Do Until rs.EOF
    With rs2
        .AddNew
        .Fields("FieldNameHere") = rs.Fields(0)
        .Fields("FieldNameHere") = rs.Fields(1)
        .Update
    End With
    rs.MoveNext
 Loop
End If

HTH << MaZeWorX >> "I have not failed I have only found ten thousand ways that don't work

 

[puforee]

MaZeWorX I thank you for all your input. I have solved my issue by using this code:

Function fOSUserName() As String
' Returns the network login name
Dim lngLen As Long, lngX As Long
Dim strUserName As String
Dim strName As String
Dim strSQL As String
strUserName = String$(254, 0)
lngLen = 255
lngX = apiGetUserName(strUserName, lngLen)
If (lngX > 0) Then
fOSUserName = Left$(strUserName, lngLen - 1)
strSQL = "INSERT INTO Usertbl (ComputerName) " _
& " VALUES ('" & Trim((fOSUserName)) & "')"
'Debug.Print strSQL
DoCmd.RunSQL strSQL
MsgBox ("Welcome to ED, " & (fOSUserName))
'Debug.Print fOSUserName
Else
fOSUserName = vbNullString
End If


End Function

It does everything thing I need a places the UserID in the user Usertbl. I have a little tweaking to do to get the field name to match the value and to suppress some dialog boxes that show, but I know how to do that.

Again I appreciate your valuable input.

Thanks,

John