Relink (ODBC) tables and query's in Access via VB.NET

[DraguVaso]

Hi,

I want to make a small application in VB.NET that relinks all the query's
and tables in an Access database that are linked via ODBC to an SQL Server.
It must be able to relink all the tables and query's to a given databse, on
a given sql server with given login and password.

Aybody knows how to do that, or better: has a sample application doing this?

Thanks in advance!

Pieter

 

[Cor]

Hi Pieter,

I was writing something to ask you to be more precise, when I thougth maybe
is this what you are looking for.

http://www.connectionstrings.com/

http://www.able-consulting.com/ADO_Conn.htm

I not be something more precise please?

Cor

 

[DraguVaso]

No, it's not that: what I need is something that refeshes the linked tables
and query's, not that connects to them. I have it in Access, but not in
VB.NET. (See underneath this). I'm just looking for a 'translation' of the
code below:

Option Compare Database
Option Explicit
'-- Global Connection Strings --
Global Const oudeDSN = "ODBC;DSN=OldOdbcName"
Private intLengte As Integer
Global Const iDSN = "OdbcName"
Global Const iSRVR = "ServerName"
Global Const iDATABASE = "DatabaseName"
Global Const iUID = "UserId"
Global Const iPWD = "Password"
Type TableDefinition
name As String
SourceTableName As String
End Type
Global arrTbl() As TableDefinition

Function RefreshAttach()
DoCmd.Hourglass True
'-----------------------------
'-- Function Refresh Attach --
'-----------------------------
On Error Resume Next
Dim ldb As Database
Dim tdf As TableDef
Dim qdf As QueryDef
Dim wrktdf As String
Dim wrksrc As String
Dim r As Integer
Dim s As Integer
Dim varReturn As Variant
' Return reference to current database.
Set ldb = CurrentDb
s = -1
Erase arrTbl

intLengte = Len(oudeDSN)

For r = 0 To ldb.TableDefs.Count - 1
' Keep Params
If (ldb.TableDefs(r).Attributes And dbAttachedODBC) And
(Left(ldb.TableDefs(r).Connect, intLengte) = oudeDSN) Then
s = s + 1
ReDim Preserve arrTbl(0 To s)
arrTbl(s).name = ldb.TableDefs(r).name
arrTbl(s).SourceTableName = ldb.TableDefs(r).SourceTableName
End If
Next r
For r = 0 To s
varReturn = SysCmd(acSysCmdSetStatus, "Attaching Table " &
arrTbl(r).name)
ldb.TableDefs.Delete arrTbl(r).name
ldb.TableDefs.Refresh
Set tdf = ldb.CreateTableDef(arrTbl(r).name, dbAttachSavePWD)
tdf.SourceTableName = arrTbl(r).SourceTableName
tdf.Connect = "ODBC;DSN=" & iDSN & ";SRVR=" & iSRVR & ";DATABASE=" &
iDATABASE & ";UID=" & iUID & ";PWD=" & iPWD & ";TABLE=" &
arrTbl(r).SourceTableName & ""
On Error Resume Next
ldb.TableDefs.Append tdf
On Error GoTo RefreshAttach_Err
ldb.TableDefs.Refresh
Set tdf = Nothing
Next r
Erase arrTbl
s = -1
For r = 0 To ldb.QueryDefs.Count - 1
' Keep Params
If (ldb.QueryDefs(r).Type = dbQSQLPassThrough) And
(Left(ldb.QueryDefs(r).Connect, intLengte) = oudeDSN) Then
s = s + 1
ReDim Preserve arrTbl(0 To s)
arrTbl(s).name = ldb.QueryDefs(r).name
End If
Next r

For r = 0 To s
varReturn = SysCmd(acSysCmdSetStatus, "Attaching Query " &
arrTbl(r).name)
Set qdf = ldb.QueryDefs(arrTbl(r).name)
qdf.Connect = "ODBC;DSN=" & iDSN & ";SRVR=" & iSRVR & ";DATABASE=" &
iDATABASE & ";UID=" & iUID & ";PWD=" & iPWD & ""
ldb.QueryDefs.Refresh
Set qdf = Nothing
Next r

Set ldb = Nothing

RefreshAttach_End:
varReturn = SysCmd(acSysCmdSetStatus, " ")
DoCmd.Hourglass False
Exit Function

RefreshAttach_Err:
' Display error information.
DoCmd.Hourglass False
MsgBox "Error number " & Err.Number & ": " & Err.Description
' Resume with statement following occurrence of error.
DoCmd.Hourglass True
Resume RefreshAttach_End:
End Function

Function AttachRemoveDbo() As Integer
On Error GoTo RemoveDbo_err
Dim CurrentDatabase As Database
Dim MyDocument As Document
Dim J As Integer
Set CurrentDatabase = DBEngine(0)(0)
For J = 0 To CurrentDatabase.Containers("Tables").Documents.Count - 1
Set MyDocument = CurrentDatabase.Containers("Tables").Documents(J)
If Left(MyDocument.name, 4) = "dbo_" Then
DoCmd.Rename Mid(MyDocument.name, 5), A_TABLE, MyDocument.name
End If
Next J
AttachRemoveDbo = True
AttachRemoveDbo_exit:
Exit Function
AttachRemoveDbo_err:
MsgBox Error
AttachRemoveDbo = False
Resume AttachRemoveDbo_exit
End Function

 

[Armin Zingler]

No, it's not that: what I need is something that refeshes the linked
tables and query's, not that connects to them. I have it in Access,
but not in VB.NET. (See underneath this). I'm just looking for a
'translation' of the code below:

I didn't find a ADO.NET solution, but one using ADOX:

http://support.microsoft.com/default.aspx?scid=kb;en-us;275249

 

[Paul Clement]

¤ No, it's not that: what I need is something that refeshes the linked tables
¤ and query's, not that connects to them. I have it in Access, but not in
¤ VB.NET. (See underneath this). I'm just looking for a 'translation' of the
¤ code below:
¤
¤ Option Compare Database
¤ Option Explicit
¤ '-- Global Connection Strings --
¤ Global Const oudeDSN = "ODBC;DSN=OldOdbcName"
¤ Private intLengte As Integer
¤ Global Const iDSN = "OdbcName"
¤ Global Const iSRVR = "ServerName"
¤ Global Const iDATABASE = "DatabaseName"
¤ Global Const iUID = "UserId"
¤ Global Const iPWD = "Password"
¤ Type TableDefinition
¤ name As String
¤ SourceTableName As String
¤ End Type
¤ Global arrTbl() As TableDefinition
¤
¤ Function RefreshAttach()
¤ DoCmd.Hourglass True
¤ '-----------------------------
¤ '-- Function Refresh Attach --
¤ '-----------------------------
¤ On Error Resume Next
¤ Dim ldb As Database
¤ Dim tdf As TableDef
¤ Dim qdf As QueryDef
¤ Dim wrktdf As String
¤ Dim wrksrc As String
¤ Dim r As Integer
¤ Dim s As Integer
¤ Dim varReturn As Variant
¤ ' Return reference to current database.
¤ Set ldb = CurrentDb
¤ s = -1
¤ Erase arrTbl
¤
¤ intLengte = Len(oudeDSN)
¤
¤ For r = 0 To ldb.TableDefs.Count - 1
¤ ' Keep Params
¤ If (ldb.TableDefs(r).Attributes And dbAttachedODBC) And
¤ (Left(ldb.TableDefs(r).Connect, intLengte) = oudeDSN) Then
¤ s = s + 1
¤ ReDim Preserve arrTbl(0 To s)
¤ arrTbl(s).name = ldb.TableDefs(r).name
¤ arrTbl(s).SourceTableName = ldb.TableDefs(r).SourceTableName
¤ End If
¤ Next r
¤ For r = 0 To s
¤ varReturn = SysCmd(acSysCmdSetStatus, "Attaching Table " &
¤ arrTbl(r).name)
¤ ldb.TableDefs.Delete arrTbl(r).name
¤ ldb.TableDefs.Refresh
¤ Set tdf = ldb.CreateTableDef(arrTbl(r).name, dbAttachSavePWD)
¤ tdf.SourceTableName = arrTbl(r).SourceTableName
¤ tdf.Connect = "ODBC;DSN=" & iDSN & ";SRVR=" & iSRVR & ";DATABASE=" &
¤ iDATABASE & ";UID=" & iUID & ";PWD=" & iPWD & ";TABLE=" &
¤ arrTbl(r).SourceTableName & ""
¤ On Error Resume Next
¤ ldb.TableDefs.Append tdf
¤ On Error GoTo RefreshAttach_Err
¤ ldb.TableDefs.Refresh
¤ Set tdf = Nothing
¤ Next r
¤ Erase arrTbl
¤ s = -1
¤ For r = 0 To ldb.QueryDefs.Count - 1
¤ ' Keep Params
¤ If (ldb.QueryDefs(r).Type = dbQSQLPassThrough) And
¤ (Left(ldb.QueryDefs(r).Connect, intLengte) = oudeDSN) Then
¤ s = s + 1
¤ ReDim Preserve arrTbl(0 To s)
¤ arrTbl(s).name = ldb.QueryDefs(r).name
¤ End If
¤ Next r
¤
¤ For r = 0 To s
¤ varReturn = SysCmd(acSysCmdSetStatus, "Attaching Query " &
¤ arrTbl(r).name)
¤ Set qdf = ldb.QueryDefs(arrTbl(r).name)
¤ qdf.Connect = "ODBC;DSN=" & iDSN & ";SRVR=" & iSRVR & ";DATABASE=" &
¤ iDATABASE & ";UID=" & iUID & ";PWD=" & iPWD & ""
¤ ldb.QueryDefs.Refresh
¤ Set qdf = Nothing
¤ Next r
¤
¤ Set ldb = Nothing
¤
¤ RefreshAttach_End:
¤ varReturn = SysCmd(acSysCmdSetStatus, " ")
¤ DoCmd.Hourglass False
¤ Exit Function
¤
¤ RefreshAttach_Err:
¤ ' Display error information.
¤ DoCmd.Hourglass False
¤ MsgBox "Error number " & Err.Number & ": " & Err.Description
¤ ' Resume with statement following occurrence of error.
¤ DoCmd.Hourglass True
¤ Resume RefreshAttach_End:
¤ End Function
¤
¤ Function AttachRemoveDbo() As Integer
¤ On Error GoTo RemoveDbo_err
¤ Dim CurrentDatabase As Database
¤ Dim MyDocument As Document
¤ Dim J As Integer
¤ Set CurrentDatabase = DBEngine(0)(0)
¤ For J = 0 To CurrentDatabase.Containers("Tables").Documents.Count - 1
¤ Set MyDocument = CurrentDatabase.Containers("Tables").Documents(J)
¤ If Left(MyDocument.name, 4) = "dbo_" Then
¤ DoCmd.Rename Mid(MyDocument.name, 5), A_TABLE, MyDocument.name
¤ End If
¤ Next J
¤ AttachRemoveDbo = True
¤ AttachRemoveDbo_exit:
¤ Exit Function
¤ AttachRemoveDbo_err:
¤ MsgBox Error
¤ AttachRemoveDbo = False
¤ Resume AttachRemoveDbo_exit
¤ End Function
¤

You should be able to Refresh linked tables using ADOX (Microsoft ADO Ext 2.x for DDL and Security):

Sub RefreshLinkedTablesWithADOX()

Dim ADOXTable As New ADOX.Table
Dim ADOXCatalog As New ADOX.Catalog
Dim ADOConnection As New ADODB.Connection
Dim LinkProviderString As String
Dim LinkDataSource As String

Try

ADOConnection.Open("Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=e:\My Documents\db1.mdb;" & _
"Jet OLEDB:Engine Type=4;")

ADOXCatalog.ActiveConnection = ADOConnection

For Each ADOXTable In ADOXCatalog.Tables
If ADOXTable.Type = "LINK" Then
LinkProviderString = ADOXTable.Properties("Jet OLEDB:Link Provider
String").Value
LinkDataSource = ADOXTable.Properties("Jet OLEDB:Link Datasource").Value
ADOXTable.Properties("Jet OLEDB:Link Provider String").Value =
LinkProviderString
ADOXTable.Properties("Jet OLEDB:Link Datasource").Value = LinkDataSource
End If
Next
Catch ex As Exception
MessageBox.Show(ex.Message)
Finally
ADOConnection.Close()
End Try

End Sub


Paul ~~~ (e-mail address removed)
Microsoft MVP (Visual Basic)

 

[DraguVaso]

That's what I was looking for! I'll try it tomorrow!
I guess it's allmost the same for refreshing query's?

Thanks a lot!

Pieter

¤ No, it's not that: what I need is something that refeshes the linked tables
¤ and query's, not that connects to them. I have it in Access, but not in
¤ VB.NET. (See underneath this). I'm just looking for a 'translation' of the
¤ code below:
¤
¤ Option Compare Database
¤ Option Explicit
¤ '-- Global Connection Strings --
¤ Global Const oudeDSN = "ODBC;DSN=OldOdbcName"
¤ Private intLengte As Integer
¤ Global Const iDSN = "OdbcName"
¤ Global Const iSRVR = "ServerName"
¤ Global Const iDATABASE = "DatabaseName"
¤ Global Const iUID = "UserId"
¤ Global Const iPWD = "Password"
¤ Type TableDefinition
¤ name As String
¤ SourceTableName As String
¤ End Type
¤ Global arrTbl() As TableDefinition
¤
¤ Function RefreshAttach()
¤ DoCmd.Hourglass True
¤ '-----------------------------
¤ '-- Function Refresh Attach --
¤ '-----------------------------
¤ On Error Resume Next
¤ Dim ldb As Database
¤ Dim tdf As TableDef
¤ Dim qdf As QueryDef
¤ Dim wrktdf As String
¤ Dim wrksrc As String
¤ Dim r As Integer
¤ Dim s As Integer
¤ Dim varReturn As Variant
¤ ' Return reference to current database.
¤ Set ldb = CurrentDb
¤ s = -1
¤ Erase arrTbl
¤
¤ intLengte = Len(oudeDSN)
¤
¤ For r = 0 To ldb.TableDefs.Count - 1
¤ ' Keep Params
¤ If (ldb.TableDefs(r).Attributes And dbAttachedODBC) And
¤ (Left(ldb.TableDefs(r).Connect, intLengte) = oudeDSN) Then
¤ s = s + 1
¤ ReDim Preserve arrTbl(0 To s)
¤ arrTbl(s).name = ldb.TableDefs(r).name
¤ arrTbl(s).SourceTableName = ldb.TableDefs(r).SourceTableName
¤ End If
¤ Next r
¤ For r = 0 To s
¤ varReturn = SysCmd(acSysCmdSetStatus, "Attaching Table " &
¤ arrTbl(r).name)
¤ ldb.TableDefs.Delete arrTbl(r).name
¤ ldb.TableDefs.Refresh
¤ Set tdf = ldb.CreateTableDef(arrTbl(r).name, dbAttachSavePWD)
¤ tdf.SourceTableName = arrTbl(r).SourceTableName
¤ tdf.Connect = "ODBC;DSN=" & iDSN & ";SRVR=" & iSRVR & ";DATABASE=" &
¤ iDATABASE & ";UID=" & iUID & ";PWD=" & iPWD & ";TABLE=" &
¤ arrTbl(r).SourceTableName & ""
¤ On Error Resume Next
¤ ldb.TableDefs.Append tdf
¤ On Error GoTo RefreshAttach_Err
¤ ldb.TableDefs.Refresh
¤ Set tdf = Nothing
¤ Next r
¤ Erase arrTbl
¤ s = -1
¤ For r = 0 To ldb.QueryDefs.Count - 1
¤ ' Keep Params
¤ If (ldb.QueryDefs(r).Type = dbQSQLPassThrough) And
¤ (Left(ldb.QueryDefs(r).Connect, intLengte) = oudeDSN) Then
¤ s = s + 1
¤ ReDim Preserve arrTbl(0 To s)
¤ arrTbl(s).name = ldb.QueryDefs(r).name
¤ End If
¤ Next r
¤
¤ For r = 0 To s
¤ varReturn = SysCmd(acSysCmdSetStatus, "Attaching Query " &
¤ arrTbl(r).name)
¤ Set qdf = ldb.QueryDefs(arrTbl(r).name)
¤ qdf.Connect = "ODBC;DSN=" & iDSN & ";SRVR=" & iSRVR & ";DATABASE=" &
¤ iDATABASE & ";UID=" & iUID & ";PWD=" & iPWD & ""
¤ ldb.QueryDefs.Refresh
¤ Set qdf = Nothing
¤ Next r
¤
¤ Set ldb = Nothing
¤
¤ RefreshAttach_End:
¤ varReturn = SysCmd(acSysCmdSetStatus, " ")
¤ DoCmd.Hourglass False
¤ Exit Function
¤
¤ RefreshAttach_Err:
¤ ' Display error information.
¤ DoCmd.Hourglass False
¤ MsgBox "Error number " & Err.Number & ": " & Err.Description
¤ ' Resume with statement following occurrence of error.
¤ DoCmd.Hourglass True
¤ Resume RefreshAttach_End:
¤ End Function
¤
¤ Function AttachRemoveDbo() As Integer
¤ On Error GoTo RemoveDbo_err
¤ Dim CurrentDatabase As Database
¤ Dim MyDocument As Document
¤ Dim J As Integer
¤ Set CurrentDatabase = DBEngine(0)(0)
¤ For J = 0 To CurrentDatabase.Containers("Tables").Documents.Count - 1
¤ Set MyDocument = CurrentDatabase.Containers("Tables").Documents(J)
¤ If Left(MyDocument.name, 4) = "dbo_" Then
¤ DoCmd.Rename Mid(MyDocument.name, 5), A_TABLE, MyDocument.name
¤ End If
¤ Next J
¤ AttachRemoveDbo = True
¤ AttachRemoveDbo_exit:
¤ Exit Function
¤ AttachRemoveDbo_err:
¤ MsgBox Error
¤ AttachRemoveDbo = False
¤ Resume AttachRemoveDbo_exit
¤ End Function
¤

You should be able to Refresh linked tables using ADOX (Microsoft ADO Ext 2.x for DDL and Security):

Sub RefreshLinkedTablesWithADOX()

Dim ADOXTable As New ADOX.Table
Dim ADOXCatalog As New ADOX.Catalog
Dim ADOConnection As New ADODB.Connection
Dim LinkProviderString As String
Dim LinkDataSource As String

Try

ADOConnection.Open("Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=e:\My Documents\db1.mdb;" & _
"Jet OLEDB:Engine Type=4;")

ADOXCatalog.ActiveConnection = ADOConnection

For Each ADOXTable In ADOXCatalog.Tables
If ADOXTable.Type = "LINK" Then
LinkProviderString = ADOXTable.Properties("Jet OLEDB:Link Provider
String").Value
LinkDataSource = ADOXTable.Properties("Jet OLEDB:Link Datasource").Value
ADOXTable.Properties("Jet OLEDB:Link Provider String").Value =
LinkProviderString
ADOXTable.Properties("Jet OLEDB:Link

Datasource").Value = LinkDataSource

 

[Paul Clement]

¤ That's what I was looking for! I'll try it tomorrow!
¤ I guess it's allmost the same for refreshing query's?
¤

Can't say I've tried it with QueryDefs, but in ADOX they are defined in the Procedures collection.


Paul ~~~ (e-mail address removed)
Microsoft MVP (Visual Basic)

 

[DraguVaso]

I'm becoming mad of it!

I just don't find it for the query's!

I tried allmost everything with the Procedures colelction, and I jsut don't
find how to do it :-(

I'm now trying with DAO and Querydef, but there I just don't manage to do a
"database = new dao.database". weird and frustrating!!!

 

[Paul Clement]

¤ I'm becoming mad of it!
¤
¤ I just don't find it for the query's!
¤
¤ I tried allmost everything with the Procedures colelction, and I jsut don't
¤ find how to do it :-(
¤
¤ I'm now trying with DAO and Querydef, but there I just don't manage to do a
¤ "database = new dao.database". weird and frustrating!!!

You may want to try the following. This is about the only method I can think of that might cause a
Refresh:

Sub RefreshAccessQueryDefs()

Dim ADOXTable As New ADOX.Table
Dim ADOXCatalog As New ADOX.Catalog
Dim ADOXProc As ADOX.Procedure
Dim ADOConnection As New ADODB.Connection
Dim ProcedureName As String

Try
ADOConnection.Open("Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=e:\My Documents\db1.mdb;" & _
"Jet OLEDB:Engine Type=4;")

ADOXCatalog.ActiveConnection = ADOConnection

Dim ADOCommand As ADODB.Command
For Each ADOXProc In ADOXCatalog.Procedures
ProcedureName = ADOXProc.Name
ADOCommand = New ADODB.Command
ADOCommand = ADOXCatalog.Procedures(ProcedureName).Command
ADOCommand.CommandText = ADOXCatalog.Procedures(ProcedureName).Command.CommandText
ADOXCatalog.Procedures(ProcedureName).Command = ADOCommand
Next ADOXProc
Catch ex As Exception
MessageBox.Show(ex.Message)
Finally
ADOConnection.Close()
End Try

End Sub


Paul ~~~ (e-mail address removed)
Microsoft MVP (Visual Basic)

 

[DraguVaso]

Thanks!
Actually: this code (and the code for the tables) works most of the times.
BUT (aaargh, why this 'but', hehe):
In some case it gives me an error, and it's always with the same
Access-database I got eveytime that error: With these Access-database it
'thinks' there aren't any Tables or Procedures in it. So the statements in
the For-loop "For Each ADOXProc In ADOXCatalog.Procedures" aren't done att
all!

When I looked more closely to it it gace me an exception:
"System.Runtime.InteropServices.COMException (0x80010105): The server threw
an exception."

I runned the folowwing code:
Dim ADOConnection As New ADODB.Connection
Dim cat As New ADOX.Catalog
Dim tbl As New ADOX.Table
Dim prc As ADOX.Procedure
Dim strProcName As String
Dim cmd As ADODB.Command
SyncLock (GetType(clsDB))
Try
ADOConnection.Open("Provider=Microsoft.Jet.OLEDB.4.0;Data
Source=" & strDirFile)
cat.ActiveConnection = ADOConnection

Try
MessageBox.Show(cat.Tables.Count)

-> On the cat.Tables.Count I got the error.
More info about the error:

?ex.tostring
"System.Runtime.InteropServices.COMException (0x80010105): The server threw
an exception.
at ADOX.Tables.get_Count()
at RefreshODBC.clsDB.subRefresh() in C:\VB NET\RefreshODBC\clsDB.vb:line
29"

?ex.gettype
{System.RuntimeType}
[System.RuntimeType]: {System.RuntimeType}
Assembly: {System.Reflection.Assembly}
AssemblyQualifiedName: "System.Runtime.InteropServices.COMException,
mscorlib, Version=1.0.5000.0, Culture=neutral,
PublicKeyToken=b77a5c561934e089"
Attributes: 1056769
BaseType: {System.RuntimeType}
DeclaringType: Nothing
DefaultBinder: {System.DefaultBinder}
Delimiter: "."c
EmptyTypes: {Length=0}
FilterAttribute: {System.Reflection.MemberFilter}
FilterName: {System.Reflection.MemberFilter}
FilterNameIgnoreCase: {System.Reflection.MemberFilter}
FullName: "System.Runtime.InteropServices.COMException"
GUID: {System.Guid}
HasElementType: False
IsAbstract: False
IsAnsiClass: True
IsArray: False
IsAutoClass: False
IsAutoLayout: True
IsByRef: False
IsClass: True
IsCOMObject: False
IsContextful: False
IsEnum: False
IsExplicitLayout: False
IsImport: False
IsInterface: False
IsLayoutSequential: False
IsMarshalByRef: False
IsNestedAssembly: False
IsNestedFamANDAssem: False
IsNestedFamily: False
IsNestedFamORAssem: False
IsNestedPrivate: False
IsNestedPublic: False
IsNotPublic: False
IsPointer: False
IsPrimitive: False
IsPublic: True
IsSealed: False
IsSerializable: True
IsSpecialName: False
IsUnicodeClass: False
IsValueType: False
MemberType: TypeInfo
Missing: {System.Reflection.Missing}
Module: {System.Reflection.Module}
Name: "COMException"
Namespace: "System.Runtime.InteropServices"
ReflectedType: Nothing
TypeHandle: {System.RuntimeTypeHandle}
TypeInitializer: Nothing
UnderlyingSystemType: {System.RuntimeType}

?ex.hresult
-2147417851

Anybody had any idea?

Thanks!

 

[Paul Clement]

¤ Thanks!
¤ Actually: this code (and the code for the tables) works most of the times.
¤ BUT (aaargh, why this 'but', hehe):
¤ In some case it gives me an error, and it's always with the same
¤ Access-database I got eveytime that error: With these Access-database it
¤ 'thinks' there aren't any Tables or Procedures in it. So the statements in
¤ the For-loop "For Each ADOXProc In ADOXCatalog.Procedures" aren't done att
¤ all!
¤
¤ When I looked more closely to it it gace me an exception:
¤ "System.Runtime.InteropServices.COMException (0x80010105): The server threw
¤ an exception."
¤
¤ I runned the folowwing code:
¤ Dim ADOConnection As New ADODB.Connection
¤ Dim cat As New ADOX.Catalog
¤ Dim tbl As New ADOX.Table
¤ Dim prc As ADOX.Procedure
¤ Dim strProcName As String
¤ Dim cmd As ADODB.Command
¤ SyncLock (GetType(clsDB))
¤ Try
¤ ADOConnection.Open("Provider=Microsoft.Jet.OLEDB.4.0;Data
¤ Source=" & strDirFile)
¤ cat.ActiveConnection = ADOConnection
¤
¤ Try
¤ MessageBox.Show(cat.Tables.Count)
¤
¤ -> On the cat.Tables.Count I got the error.
¤ More info about the error:
¤
¤ ?ex.tostring
¤ "System.Runtime.InteropServices.COMException (0x80010105): The server threw
¤ an exception.
¤ at ADOX.Tables.get_Count()
¤ at RefreshODBC.clsDB.subRefresh() in C:\VB NET\RefreshODBC\clsDB.vb:line
¤ 29"
¤
¤ ?ex.gettype
¤ {System.RuntimeType}
¤ [System.RuntimeType]: {System.RuntimeType}
¤ Assembly: {System.Reflection.Assembly}
¤ AssemblyQualifiedName: "System.Runtime.InteropServices.COMException,
¤ mscorlib, Version=1.0.5000.0, Culture=neutral,
¤ PublicKeyToken=b77a5c561934e089"
¤ Attributes: 1056769
¤ BaseType: {System.RuntimeType}
¤ DeclaringType: Nothing
¤ DefaultBinder: {System.DefaultBinder}
¤ Delimiter: "."c
¤ EmptyTypes: {Length=0}
¤ FilterAttribute: {System.Reflection.MemberFilter}
¤ FilterName: {System.Reflection.MemberFilter}
¤ FilterNameIgnoreCase: {System.Reflection.MemberFilter}
¤ FullName: "System.Runtime.InteropServices.COMException"
¤ GUID: {System.Guid}
¤ HasElementType: False
¤ IsAbstract: False
¤ IsAnsiClass: True
¤ IsArray: False
¤ IsAutoClass: False
¤ IsAutoLayout: True
¤ IsByRef: False
¤ IsClass: True
¤ IsCOMObject: False
¤ IsContextful: False
¤ IsEnum: False
¤ IsExplicitLayout: False
¤ IsImport: False
¤ IsInterface: False
¤ IsLayoutSequential: False
¤ IsMarshalByRef: False
¤ IsNestedAssembly: False
¤ IsNestedFamANDAssem: False
¤ IsNestedFamily: False
¤ IsNestedFamORAssem: False
¤ IsNestedPrivate: False
¤ IsNestedPublic: False
¤ IsNotPublic: False
¤ IsPointer: False
¤ IsPrimitive: False
¤ IsPublic: True
¤ IsSealed: False
¤ IsSerializable: True
¤ IsSpecialName: False
¤ IsUnicodeClass: False
¤ IsValueType: False
¤ MemberType: TypeInfo
¤ Missing: {System.Reflection.Missing}
¤ Module: {System.Reflection.Module}
¤ Name: "COMException"
¤ Namespace: "System.Runtime.InteropServices"
¤ ReflectedType: Nothing
¤ TypeHandle: {System.RuntimeTypeHandle}
¤ TypeInitializer: Nothing
¤ UnderlyingSystemType: {System.RuntimeType}
¤
¤ ?ex.hresult
¤ -2147417851
¤
¤ Anybody had any idea?
¤

Have you tried compacting the database or running a repair. I can't think of any other reason why it
would work on your other databases but not this one.


Paul ~~~ (e-mail address removed)
Microsoft MVP (Visual Basic)