DAO.DBEngine.SystemDB

Darth Vodka

Registered User.
Local time
Today, 05:23
Joined
Sep 25, 2007
Messages
344
hmm

i think i'm missing something

if i do this

Code:
sub test1()
DAO.DBEngine.SystemDB = "\\opssvr01\tpg_bo_data\Commodity\Commodity.mdw"
debug.print DAO.DBEngine.SystemDB
end sub

i still get the default workgroup??

:confused:
 
Would you have to restart the app for it to take effect?
 
Microsoft says in its DAO reference documentation:
"For this option to have any effect, you must set the SystemDB property before your application initializes the DBEngine(that is, before creating an instance of any other DAO object). The scope of this setting is limited to your application and can't be changed without restarting your application."

Chris
 
What happens when you run the code then restart the app?
 
If I remember rightly you cannot use this syntax to change the security of the current Access database, it used for opening another database from within the current one, using the Workgroup stated in in the DBEngine.systemDB = "..." command.
 
aaaah

i see, many many thanks ken & wilko

i can't change the app's workgroup as it's already open, makes sense

thought i was going mad. thanks again
 
actually is it possible to do what i'm trying to do

Code:
Function FindLinkedTables(ByVal strDBPath As String, ByVal strWorkGroup As String, ByVal strUser As String, ByVal strPassword As String) As Boolean
    Dim db              As DAO.Database
    Dim tdLoop          As DAO.TableDef
    Dim strSQL          As String
    Dim strLinkedPath   As String
    Dim strUNC          As String
    Dim wrkJet          As DAO.Workspace
    
    'On Error GoTo errorpub
    
    If strWorkGroup <> "" Then
        DAO.DBEngine.SystemDB = strWorkGroup
        Set wrkJet = CreateWorkspace("Test", strUser, strPassword)
    End If
    
    Set db = OpenDatabase(strDBPath)
    ' Open the connection
    For Each tdLoop In db.TableDefs
        'Debug.Print tdLoop.Connect
        If Left(tdLoop.Connect, 10) = ";DATABASE=" Then
            strLinkedPath = Right(tdLoop.Connect, Len(tdLoop.Connect) - 10)
            If Left(strLinkedPath, 2) <> "\\" Then
                'convert to UNC
                strUNC = Trim(fnUNCPath(Left(strLinkedPath, 1)))
                If InStr(1, strUNC, Chr(0)) > 1 Then
                    strUNC = Left(strUNC, InStr(1, strUNC, Chr(0)) - 1)
                End If
                strUNC = Left(strUNC, Len(strUNC) - 1)
                strLinkedPath = strUNC & Right(strLinkedPath, Len(strLinkedPath) - 2)
            End If
            strSQL = "INSERT INTO tbl_links ( DatabasePath, LinkedTablePath ) SELECT '" & strDBPath & "' AS TableName, '" & strLinkedPath & "' AS TableLink;"
            CurrentDb.Execute strSQL
        End If
    Next
    Set db = Nothing
    Set wrkJet = Nothing
    
    FindLinkedTables = True
    
    Exit Function
errorpub:
    MsgBox Err.Number & " " & Err.Description

    Set db = Nothing
    Set wrkJet = Nothing
    FindLinkedTables = False
End Function

rattle through a database with a workgroup and dump all the linked tables into a table

(i have it working for non-workgroup ones)
 
So you must have ran this an gotten some kind of error. When you step through the code where does it appear to head south?
 
So you must have ran this an gotten some kind of error. When you step through the code where does it appear to head south?

on

Set wrkJet = CreateWorkspace("Test", strUser, strPassword)

because it's coming up with a user/password that isn't on the workgroup, i don't seem to have associated the workgroup to the workspace...

:confused:
 
think i have solved it

Code:
    If strWorkGroup <> "" Then
        Set x = New PrivDBEngine
        With x
            .SystemDB = strWorkGroup
            .DefaultUser = strUser
            .DefaultPassword = strPassword
        End With
    End If


    Set wrkJet = x.Workspaces(0)
    Set db = wrkJet.OpenDatabase(strDBPath)
 
Cool...

(PrivDBEngine ?)

i know, what the hell is that?

:)

worked like a dream, got some code to go through a hundred databases, some with workgroups, some Admin log in, some not and chuck a table together of all the linked tables they had in them
 
Did you have to import some third party code modules in order for the code to work?
 
Did you have to import some third party code modules in order for the code to work?

a medley of code from off the internet :)

here's the whole module i created

Code:
Option Compare Database
Option Explicit

Declare Function WNetGetConnection32 _
    Lib "mpr.dll" _
        Alias "WNetGetConnectionA" ( _
            ByVal lpszLocalName As String, _
            ByVal lpszRemoteName As String, _
            lSize As Long) _
As Long

'// 32-bit declarations:
Dim lpszRemoteName As String
'Dim lSize As Long

'// Use for the return value of WNetGetConnection() API.
Const NO_ERROR As Long = 0

'// The size used for the string buffer. Adjust this if you
'// need a larger buffer.
Const lBUFFER_SIZE As Long = 1052


Function FindLinkedTables(ByVal strDBPath As String, ByVal strWorkGroup As String, ByVal strUser As String, ByVal strPassword As String) As Boolean
    Dim db              As DAO.Database
    Dim tdLoop          As DAO.TableDef
    Dim strSQL          As String
    Dim strLinkedPath   As String
    Dim strUNC          As String
    Dim wrkJet          As DAO.Workspace
    Dim pdbeNew         As PrivDBEngine
    
    'On Error GoTo errorpub
    
    If strWorkGroup <> "" Then
        Set pdbeNew = New PrivDBEngine
        With pdbeNew
            .SystemDB = strWorkGroup
            .DefaultUser = strUser
            .DefaultPassword = strPassword
        End With
        Set wrkJet = pdbeNew.Workspaces(0)
        Set db = wrkJet.OpenDatabase(strDBPath)
    Else
        Set db = OpenDatabase(strDBPath)
    End If


    
    ' Open the connection
    For Each tdLoop In db.TableDefs
        'Debug.Print tdLoop.Connect
        If Left(tdLoop.Connect, 10) = ";DATABASE=" Then
            strLinkedPath = Right(tdLoop.Connect, Len(tdLoop.Connect) - 10)
            If Left(strLinkedPath, 2) <> "\\" Then
                'convert to UNC
                strUNC = Trim(fnUNCPath(Left(strLinkedPath, 1)))
                If InStr(1, strUNC, Chr(0)) > 1 Then
                    strUNC = Left(strUNC, InStr(1, strUNC, Chr(0)) - 1)
                End If
                strUNC = Left(strUNC, Len(strUNC) - 1)
                strLinkedPath = strUNC & Right(strLinkedPath, Len(strLinkedPath) - 2)
            End If
            strSQL = "INSERT INTO tbl_links ( DatabasePath, LinkedTablePath ) SELECT '" & strDBPath & "' AS TableName, '" & strLinkedPath & "' AS TableLink;"
            CurrentDb.Execute strSQL
        End If
    Next
    Set db = Nothing
    Set wrkJet = Nothing
    Set pdbeNew = Nothing
    
    FindLinkedTables = True
    
    Exit Function
errorpub:
    MsgBox Err.Number & " " & Err.Description

    Set db = Nothing
    Set wrkJet = Nothing
    Set pdbeNew = Nothing
    FindLinkedTables = False
End Function

Sub FindLinkedAll()
    Dim rs              As DAO.Recordset
    
    Set rs = CurrentDb.OpenRecordset("SELECT * FROM tbl_Applications")
        Do Until rs.EOF
            If rs("Ignore") = False And rs("Completed") = False Then
                rs.Edit
                rs("Completed") = FindLinkedTables(rs("DBPath"), Nz(rs("Workgroup"), ""), Nz(rs("User"), ""), Nz(rs("Password"), ""))
                rs.Update
            End If
            rs.MoveNext
        Loop
    
    Set rs = Nothing
    
    
End Sub


Function fnUNCPath(strDriveLetter As String) As String
'// Takes specified Local Drive Letter
'// eg E,D,H Etc and converts to UNC

Dim cbRemoteName As Long
Dim lStatus As Long

'// Add a colon to the drive letter entered.
strDriveLetter = Left(strDriveLetter, 1) & ":"

'// Specifies the size in charaters of the buffer.
cbRemoteName = lBUFFER_SIZE

'// Prepare a string variable by padding spaces.
lpszRemoteName = lpszRemoteName & Space(lBUFFER_SIZE)

'// Return the UNC path (eg.\\Server\Share).
lStatus = WNetGetConnection32( _
   strDriveLetter, _
   lpszRemoteName, _
   cbRemoteName)

'// Has WNetGetConnection() succeeded.
'// WNetGetConnection()returns 0 (NO_ERROR)
'// if it succesfully retrieves the UNC path.
If lStatus = NO_ERROR Then
    '// Get UNC path.
    fnUNCPath = lpszRemoteName
Else
    '// Unable to obtain the UNC path.
    fnUNCPath = strDriveLetter & ":"
End If

End Function
 

Users who are viewing this thread

Back
Top Bottom