hmm

i think i'm missing something

if i do this


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?

Would you have to restart the app for it to take effect?

don't think so

can find microsoft stuff on doing the same thing

http://support.microsoft.com/?id=163002

but doesn't seem like i can change it?

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


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


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 ?)

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


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

Ah ha -

About 3/4 the way down:

http://www.microsoft.com/technet/prodtechnol/sql/70/proddocs/msjet/jetch02.mspx?mfr=true