ODBC problem

S

Sharon

I have a patent docketing system that's reporting feature is an Access
database. I had to “build†a licensing module into the software and somehow
the new reports etc. that I have generated are not being recognized by the
database.
When I go to Start/Administrative Tools/Data Source (ODBC) and go to the tab
to configure the system dsn, when I get to the drop down containing the
server names, there are three; two with exactly the same name (Argon) and one
that is Argon2.
I was told by the owner’s of the software that to create a new view, I
needed to go into Enterprise Manager and drop the current view and also go
into the Access database and drop that view, then re-create the link to the
view in the Linking Manager. I have done this, but it is not recognizing the
“connection.†When I try to run the report, I get a message saying that it
can’t find the view, but I know the view is there because I can go and look
at the data generated in Access.
I went to Doug Steele’s website, and found an article about making a module
for a DSN-less connection and tried to incorporate that code into my database
and well, although I don’t think I screwed anything up too bad, it still is
not working. If this would work, would it fix the problem with the dsn? I
am sure I didn’t “fill in all the holes†in the code that I needed to, so the
code is not running. This is the code:

Option Compare Database

Type TableDetails
TableName As String
SourceTableName As String
Attributes As Long
IndexSQL As String
Description As Variant
End Type

Sub FixConnections(Argon As String, IPMaster As String)
' This code was originally written by
' Doug Steele, MVP (e-mail address removed)
' You are free to use it in any application
' provided the copyright notice is left unchanged.
'
' Description: This subroutine looks for any TableDef objects in the
' database which have a connection string, and changes the
' Connect property of those TableDef objects to use a
' DSN-less connection.
' This specific routine connects to the specified SQL Server
' database on a specified server. It assumes trusted connection.
'
' Inputs: Argon: Name of the SQL Server server (string)
' IPMaster: Name of the database on that server (string)
'

On Error GoTo Err_FixConnections

Dim dbCurrent As DAO.Database
Dim prpCurrent As DAO.Property
Dim tdfCurrent As DAO.TableDef
Dim intLoop As Integer
Dim intToChange As Integer
Dim strDescription As String
Dim typNewTables() As TableDetails

intToChange = 0

Set dbCurrent = DBEngine.Workspaces(0).Databases(0)

' Build a list of all of the connected TableDefs and
' the tables to which they're connected.

For Each tdfCurrent In dbCurrent.TableDefs
If Len(tdfCurrent.Connect) > 0 Then
ReDim Preserve typNewTables(0 To intToChange)
typNewTables(intToChange).Attributes = tdfCurrent.Attributes
typNewTables(intToChange).TableName = tdfCurrent.Name
typNewTables(intToChange).SourceTableName = tdfCurrent.SourceTableName
typNewTables(intToChange).IndexSQL = GenerateIndexSQL(tdfCurrent.Name)
typNewTables(intToChange).Description = Null
typNewTables(intToChange).Description =
tdfCurrent.Properties("Description")
intToChange = intToChange + 1
End If
Next

' Loop through all of the linked tables we found

For intLoop = 0 To (intToChange - 1)

' Delete the existing TableDef object

dbCurrent.TableDefs.Delete typNewTables(intLoop).TableName

' Create a new TableDef object, using the DSN-less connection

Set tdfCurrent = dbCurrent.CreateTableDef(typNewTables(intLoop).TableName)
tdfCurrent.Connect = "ODBC;DRIVER={sql server};DATABASE=" & _
IPMaster & ";SERVER=" & Argon & _
";Trusted_Connection=Yes;"
tdfCurrent.SourceTableName = typNewTables(intLoop).SourceTableName
dbCurrent.TableDefs.Append tdfCurrent

' Where it existed, add the Description property to the new table.

If IsNull(typNewTables(intLoop).Description) = False Then
strDescription = CStr(typNewTables(intLoop).Description)
Set prpCurrent = tdfCurrent.CreateProperty("Description", dbText,
strDescription)
tdfCurrent.Properties.Append prpCurrent
End If

' Where it existed, create the __UniqueIndex index on the new table.

If Len(typNewTables(intLoop).IndexSQL) > 0 Then
dbCurrent.Execute typNewTables(intLoop).IndexSQL, dbFailOnError
End If
Next

End_FixConnections:
Set tdfCurrent = Nothing
Set dbCurrent = Nothing
Exit Sub

Err_FixConnections:
' Specific error trapping added for Error 3291
' (Syntax error in CREATE INDEX statement.), since that's what many
' people were encountering with the old code.
' Also added error trapping for Error 3270 (Property Not Found.)
' to handle tables which don't have a description.

Select Case Err.Number
Case 3270
Resume Next
Case 3291
MsgBox "Problem creating the Index using" & vbCrLf & _
typNewTables(intLoop).IndexSQL, _
vbOKOnly + vbCritical, "Fix Connections"
Resume End_FixConnections
Case Else
MsgBox Err.Description & " (" & Err.Number & ") encountered", _
vbOKOnly + vbCritical, "Fix Connections"
Resume End_FixConnections
End Select

End Sub

Function GenerateIndexSQL(TableName As String) As String
' This code was originally written by
' Doug Steele, MVP (e-mail address removed)
' You are free to use it in any application,
' provided the copyright notice is left unchanged.
'
' Description: Linked Tables should have an index __uniqueindex.
' This function looks for that index in a given
' table and creates an SQL statement which can
' recreate that index.
' (There appears to be no other way to do this!)
' If no such index exists, the function returns an
' empty string ("").
'
' Inputs: TableDefObject: Reference to a Table (TableDef object)
'
' Returns: An SQL string (or an empty string)
'

On Error GoTo Err_GenerateIndexSQL

Dim dbCurr As DAO.Database
Dim idxCurr As DAO.Index
Dim fldCurr As DAO.Field
Dim strSQL As String
Dim tdfCurr As DAO.TableDef

Set dbCurr = CurrentDb()
Set tdfCurr = dbCurr.TableDefs(TableName)

If tdfCurr.Indexes.Count > 0 Then

' Ensure that there's actually an index named
' "__UnigueIndex" in the table

On Error Resume Next
Set idxCurr = tdfCurr.Indexes("__uniqueindex")
If Err.Number = 0 Then
On Error GoTo Err_GenerateIndexSQL

' Loop through all of the fields in the index,
' adding them to the SQL statement

If idxCurr.Fields.Count > 0 Then
strSQL = "CREATE INDEX __UniqueIndex ON [" & TableName & "] ("
For Each fldCurr In idxCurr.Fields
strSQL = strSQL & "[" & fldCurr.Name & "], "
Next

' Remove the trailing comma and space

strSQL = Left$(strSQL, Len(strSQL) - 2) & ")"
End If
End If
End If

End_GenerateIndexSQL:
Set fldCurr = Nothing
Set tdfCurr = Nothing
Set dbCurr = Nothing
GenerateIndexSQL = strSQL
Exit Function

Err_GenerateIndexSQL:
' Error number 3265 is "Not found in this collection
' (in other words, either the tablename is invalid, or
' it doesn't have an index named __uniqueindex)
If Err.Number <> 3265 Then
MsgBox Err.Description & " (" & Err.Number & ") encountered", _
vbOKOnly + vbCritical, "Generate Index SQL"
End If
Resume End_GenerateIndexSQL

End Function

Any help is appreciated.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top