viewing ldb users

[munkee]

I am using the following adapted code supplied by Adezii in one of the vba articles.

Public Sub GenerateUserList()
Const conUsers = "{947bb102-5d43-11d1-bdbf-00c04fb92675}"
  
Dim cnn As ADODB.Connection, fld As ADODB.Field, strUser As String
Dim rst As ADODB.Recordset, intUser As Integer, varValue As Variant
Dim querystring As String
Dim qrysql As String
Dim outputname As String
Dim passiton As String
Dim sqlstringer As String
Dim ticker As Integer

Set cnn = CurrentProject.Connection
Set rst = cnn.OpenSchema(Schema:=adSchemaProviderSpecific, SchemaID:=conUsers)
  
'Set List Box Heading
strUser = "Computer;UserName;Connected?;Suspect?;Actual Name?"
ticker = 0
With rst    'fills Recordset (rst) with User List data
  Do Until .EOF
    intUser = intUser + 1
    
    

      For Each fld In .Fields
        
        varValue = fld.Value
          
    ticker = ticker + 1
    If ticker = 5 Then ticker = 1
    
          'Debug.Print ticker
          'Some of the return values are Null-Terminated Strings, if
          'so strip them off
          
          If InStr(varValue, vbNullChar) > 0 Then
            varValue = Left(varValue, InStr(varValue, vbNullChar) - 1)
    
          End If
      
            Select Case ticker
            Case 1
            passiton = varValue
            outputname = GetTheirName(passiton)
            Case 2
            Case 3
            Case 4
            varValue = varValue & ";" & "'" & outputname & "'"
            Case Else
            Debug.Print ticker
            
          End Select
          strUser = strUser & ";" & varValue
          Debug.Print strUser
      Next
        .MoveNext
  Loop
End With

 
'Set up List Box Parameters
Me!lstUsers.ColumnCount = 5
Me!lstUsers.RowSourceType = "Value List"
Me!lstUsers.ColumnHeads = True
Me!lstUsers.RowSource = strUser 'populate the List Box


'Routine cleanup chores
Set fld = Nothing
Set rst = Nothing
Set cnn = Nothing
End Sub

I know my changes are SO ugly but alas it works! anyway. My issue is that for some reason the code is only showing users within the ldb file created by the front end of the database.

How do I adapt this to point to the backend, a specific one at that.

[munkee]

?currentproject.Connection
Provider=Microsoft.Jet.OLEDB.4.0;User ID=Admin;Data Source=K:\corp\NonConformance\Holding&Converting\NCCLOG03.mdb;Mode=Share Deny None;Extended Properties="";Jet OLEDB:System database=C:\Documents and Settings\mobbe00C\Application Data\Microsoft\Access\System.mdw;Jet OLEDB:Registry Path=Software\Microsoft\Office\11.0\Access\Jet\4.0;Jet OLEDB:Database Password="";Jet OLEDB:Engine Type=5;Jet OLEDB:Database Locking Mode=1;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New Database Password="";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False

I did a call of the currentproject. connection in my immediate windot and returned the above. I expect I simply need to change the connection to point to the backend as the datasource is pointing to the front.

[munkee]

Public Sub GenerateUserList()
Dim cnn As Object
Dim rst As Object
Dim fld As ADODB.Field
Dim strUser As String
Dim intUser As Integer
Dim varValue As Variant
Dim querystring As String
Dim qrysql As String
Dim outputname As String
Dim passiton As String
Dim sqlstringer As String
Dim ticker As Integer


    Set cnn = CreateObject("ADODB.Connection")
    Set rst = CreateObject("ADODB.Recordset")

    cnn.Provider = "Microsoft.Jet.OLEDB.4.0"
    cnn.Open "Data Source=" & Mid([DBEngine].[Workspaces](0).[Databases](0).[TableDefs]("tbllog").[Connect], 11)

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

  
'Set List Box Heading
strUser = "Computer;UserName;Connected?;Suspect?;Actual Name?"
ticker = 0
With rst    'fills Recordset (rst) with User List data
  Do Until .EOF
    intUser = intUser + 1
    
    

      For Each fld In .Fields
        
        varValue = fld.Value
          
    ticker = ticker + 1
    If ticker = 5 Then ticker = 1
    
          'Debug.Print ticker
          'Some of the return values are Null-Terminated Strings, if
          'so strip them off
          
          If InStr(varValue, vbNullChar) > 0 Then
            varValue = Left(varValue, InStr(varValue, vbNullChar) - 1)
    
          End If
      
            Select Case ticker
            Case 1
            passiton = varValue
            outputname = GetTheirName(passiton)
            Case 2
            Case 3
            Case 4
            varValue = varValue & ";" & "'" & outputname & "'"
            Case Else
            Debug.Print ticker
            
          End Select
          strUser = strUser & ";" & varValue
          Debug.Print strUser
      Next
        .MoveNext
  Loop
End With

 
'Set up List Box Parameters
Me!lstUsers.ColumnCount = 5
Me!lstUsers.RowSourceType = "Value List"
Me!lstUsers.ColumnHeads = True
Me!lstUsers.RowSource = strUser 'populate the List Box


'Routine cleanup chores
Set fld = Nothing
Set rst = Nothing
Set cnn = Nothing
End Sub

Fixed