[Last Call] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 485
  • Last Modified:

ODBCDirect is no longer supported.

Hello,

We are using a program that is no longer under support from the manufacturer.  Its an older program with a SQL server backend.  There is a button on this program that launches MSAccess in refrence to an mdb file.  In Access 2010 and 2013 we get an error message "ODBCDirect is no longer supported.  Rewrite the code to use ADO instead of DAO".  

I looked in the Visual basic editor and I see that it is pulling from an ini file some connection parameters and I see these lines that I think need to be updated:

Set wrkODBC = CreateWorkspace("NewODBCWorkspace", "admin", "", dbUseODBC)

 'Open READ-ONLY connection object based on information entered in DSN.
    Set dbsProsper = wrkODBC.OpenConnection("ProsperWorkspace", _
        dbDriverNoPrompt, True, "ODBC;UID=" & gstrUID & ";PWD=" & gstrPWD & ";DSN=" & gstrDSN & ";")


Those variables gstrUID, gstrPWD and gstrDSN are retrieved from an ini file in code above that.

Also wrkODBC and dbsProsper are initizlized at the top of the module PRM_Routines as so:
Public wrkODBC As Workspace
Public dbsProsper As Database

Do you know if there is a quick and easy way to alter this to work in Access 2010 and 2013?

If you need the whole code, I can attach it as a text file.
0
ITdiamond
Asked:
ITdiamond
  • 5
  • 5
1 Solution
 
Jim Dettman (Microsoft MVP/ EE MVE)PresidentCommented:
It depends on why ODBC Direct was used.  Usually it was for performance and/or the ability to run async queries.

DAO still supports ODBC and in general, as long as you haven't used ODBCDIrect specific features, you can move back and forth between the two fairly easily.

<<Do you know if there is a quick and easy way to alter this to work in Access 2010 and 2013?>>

A through review of the code is required before you can have an answer.

Jim.
0
 
ITdiamondAuthor Commented:
Here is the module PRM_Routines that appears to be where things are looking at.

Option Compare Database
Option Explicit

Public gstrDatabase As String
Public gstrUID As String
Public gstrPWD As String
Public gstrDSN As String
Public gstrTableList As String
Public gintLinkCount As Integer
Public gintReportImportCount As Integer
Public gstrPRMNames() As String
Public gIsRelationshipsDirty As Boolean
Public wrkODBC As Workspace
Public dbsProsper As Database
Public ThisMDB As Database
Function AddAppProperty(strName As String, varType As Variant, varValue As Variant) As Integer
    Dim dbs As Object, prp As Variant
    Const conPropNotFoundError = 3270

    Set dbs = CurrentDb
    On Error GoTo AddProp_Err
    dbs.Properties(strName) = varValue
    AddAppProperty = True

AddProp_Bye:
    Exit Function

AddProp_Err:
    If Err = conPropNotFoundError Then
        Set prp = dbs.CreateProperty(strName, varType, varValue)
        dbs.Properties.Append prp
        Resume
    Else
        AddAppProperty = False
        Resume AddProp_Bye
    End If
End Function

'This is the starting point of this application:
'Confirms connection to Prosper database (links tables if necessary)
'Checks for any reports to import in same directory, and then opens form "frmReports"
Function StartUp()
    On Error GoTo StartUpError
    Dim strTempTable As String, i As Integer, varReturn As Variant
    'Stop
    'Minimize the Database window
    DoCmd.Minimize
    'Stop
    Dim intX As Integer
    Const DB_Text As Long = 10
    intX = AddAppProperty("AppTitle", DB_Text, "Touché Report Manager")
    
    Application.RefreshTitleBar

    '
    gIsRelationshipsDirty = False
    'Display message  "Connecting to Prosper database..." in status bar
    varReturn = SysCmd(acSysCmdSetStatus, "Connecting to Prosper database..." & strTempTable)
     
    'Create an instance of this Access database object
    Set ThisMDB = CurrentDb
    
    'Get location of Prosper.ini from Command Line
    If UCase((Right$(Command, 4))) <> ".INI" Then
        MsgBox "You do not have permission to run this program."
        Quit
    ElseIf Dir(Command) = "" Then
        'Check that the file Prosper.ini exists
        MsgBox "File: " & Command & " not found!"
        Quit
    End If
    
    'Read Data properties from Prosper.ini into global variables
    CGeneral.IniPath = Command
    gstrUID = CGeneral.IniRead("Data Source", "Network UID")
    gstrPWD = CGeneral.IniRead("Data Source", "Network PWD")
    gstrDSN = CGeneral.IniRead("Data Source", "Network DSN")
    gstrTableList = CGeneral.IniRead("PRM", "TableList1")
    gstrTableList = gstrTableList & CGeneral.IniRead("PRM", "TableList2")
    
    'Validate the properties that were just read from Prosper.ini
    If gstrTableList = "" Then
        MsgBox "Invalid INI file setting for 'TableList'"
        Quit
    ElseIf gstrUID = "" Then
        MsgBox "Invalid INI file setting for 'Network UID'"
        Quit
    ElseIf gstrDSN = "" Then
        MsgBox "Invalid INI file setting for 'Network DSN'"
        Quit
    End If
    
    Set wrkODBC = CreateWorkspace("NewODBCWorkspace", "admin", "", dbUseODBC)
    
    'Open READ-ONLY connection object based on information entered in DSN.
    Set dbsProsper = wrkODBC.OpenConnection("ProsperWorkspace", _
        dbDriverNoPrompt, True, "ODBC;UID=" & gstrUID & ";PWD=" & gstrPWD & ";DSN=" & gstrDSN & ";")
    
    'Link or Re-link all tables specified in gstrTableList if any are unattached or DSN is changed
    i = 1
    Do
        strTempTable = CGeneral.ParseString(gstrTableList, ",", i)
        varReturn = SysCmd(acSysCmdSetStatus, "Linking Table " & strTempTable)
        If strTempTable <> "" Then
            LinkTable strTempTable
            i = i + 1
        End If
    Loop Until strTempTable = ""
    
    'Close Temporary workspace/database object
    dbsProsper.Close: Set dbsProsper = Nothing
    wrkODBC.Close: Set wrkODBC = Nothing
    
    'If any table was relinked in LinkTable(), then re-create all table relationships
    
    If gIsRelationshipsDirty = True Then
        varReturn = SysCmd(acSysCmdSetStatus, "Recreating Relationships...")
        RecreateRelationships
    End If
    
    
    'Display no. of tables actually linked (if any):
    If gintLinkCount > 0 Then
        'MsgBox gintLinkCount & " tables were linked or re-linked!"
    End If
   
    'Check for and import any reports from any previous version of PRM database
     ImportReports
    
    DoCmd.OpenForm "frmReports"
    
    'Clear the Status Bar
    varReturn = SysCmd(acSysCmdClearStatus)
    
    'Lock the Database
    LockDB (True)
            
    'Remove instance of this Database object
    Set ThisMDB = Nothing

    Exit Function

StartUpError:
    If Err.Number = 68 Then
        MsgBox "Error in StartUp(): ODBC is database currently unavailable"
    Else
        MsgBox "Error in StartUp():" & vbCrLf & Err.Description
    End If
End Function

Sub RecreateRelationships()
    On Error Resume Next
    Dim rln As Relation, fld As Field
    Dim rst As Recordset
    
    'Stop
    
    'Delete any leftover relationships
    For Each rln In ThisMDB.Relations
        ThisMDB.Relations.Delete rln.Name
    Next
    
    'Open Relationships table
    Set rst = ThisMDB.OpenRecordset("Relationships")
    rst.MoveFirst
    
    'Loop through Relationships table and create all
    'the pre-defined table relationships
    With rst
        Do While Not .EOF
            Set rln = ThisMDB.CreateRelation(!RelationshipName, !TableName, !ForeignTablename, !Attributes)
                Set fld = rln.CreateField(!FieldName)
                    fld.ForeignName = !ForeignFieldName
                    rln.Fields.Append fld
                    ThisMDB.Relations.Append rln
                Set fld = Nothing
            Set rln = Nothing
            .MoveNext
        Loop
        .Close
    End With

    'Clean up
    Set rst = Nothing
    Set rln = Nothing
    Set fld = Nothing
    
End Sub

Sub SaveRelationships()
    On Error Resume Next
    Dim rln As Relation, fld As Field
    Dim rst As Recordset

    'Stop
    
    'This refreshes the database (useful when testing):
    If Not ThisMDB Is Nothing Then
        Set ThisMDB = Nothing
    End If
    Set ThisMDB = CurrentDb
    
    'Exit if no relationships to save
    If ThisMDB.Relations.Count = 0 Then Exit Sub
    
    'Clear Relationships table
    ThisMDB.Execute ("Delete * From Relationships")
    
    'Open (now blank) Relationships table
    Set rst = ThisMDB.OpenRecordset("Relationships")
    
    'Loop through Relationships in database
    'and save all table relationships to Relationships table
    For Each rln In ThisMDB.Relations
        With rln
            For Each fld In .Fields
                rst.AddNew
                rst!RelationshipName = .Name
                rst!TableName = .Table
                rst!ForeignTablename = .ForeignTable
                rst!Attributes = .Attributes
                
                rst!FieldName = fld.Name
                rst!ForeignFieldName = fld.ForeignName
                rst.Update
            Next
        End With
    Next
    
    'Clean up
    rst.Close
    Set rst = Nothing
    Set rln = Nothing
    Set fld = Nothing
End Sub

'Used by Sub LinkTable() to check if a table is already linked:
'Returns True only if strTableName is the name of an exisiting table
Public Function TableExists(strTableName As String) As Boolean
    On Error Resume Next
    Dim tdfLinked As TableDef, i As Integer
    TableExists = False
    With CurrentDb
        If .TableDefs.Count > 0 Then
            For i = 0 To .TableDefs.Count - 1
                If strTableName = .TableDefs(i).Name Then
                    TableExists = True
                    Exit For
                End If
            Next
        End If
    End With
End Function

'Used by Sub Startup() to link tables from the Prosper database
Public Function LinkTable(strTableName As String)
    On Error GoTo LinkError
    Dim tdfLinked As TableDef, strDSN As String, intDSNpos As Integer
   
   'Stop
   
    'Link table (If already linked, refresh link)
    If TableExists(strTableName) = True Then
        
        Set tdfLinked = ThisMDB.TableDefs(strTableName)
        With tdfLinked
            
            'Check for a different DSN to the one in the attached table
            'in case the user points to a different database via the Prosper ini file:
            intDSNpos = InStr(1, .Connect, "DSN=")
            If intDSNpos > 0 Then
                intDSNpos = intDSNpos + 4
                strDSN = Mid$(.Connect, intDSNpos, InStr(intDSNpos, .Connect, ";") - intDSNpos)
            End If
        End With
            
        'If current table is attached to an SQL server and the supplied DSN is a another SQL server database, OR
        'The currently attached database is Access and the supplied DSN is SQL server, OR
        'The currently attached database is SQL Server and the supplied DSN is Access, OR
        'Both databases are Access, but different MDB files; then,
        'Unattach the current table and attach a new one from supplied DSN
        '(When attaching, check new db for type = Access or SQL server and attach via jet or ODBC respectively)
        If (strDSN <> "" And strDSN <> gstrDSN) Or _
           (strDSN = "" And InStr(1, dbsProsper.Connect, ".mdb") = 0) Or _
           (strDSN <> "" And InStr(1, dbsProsper.Connect, ".mdb") > 0) Or _
           (strDSN = "" And InStr(1, dbsProsper.Connect, ".mdb") > 0 And _
             (GetConnectParam(tdfLinked.Connect, "DATABASE") <> GetConnectParam(dbsProsper.Connect, "DBQ"))) Then
            
            'Delete (Connection of) linked table
            ThisMDB.TableDefs.Delete strTableName
            Set tdfLinked = Nothing

            'Recreate table
            Set tdfLinked = ThisMDB.CreateTableDef(strTableName)
                        
            'If the supplied DSN is Access (not SQL server) then
            'don't connect via ODBC, connect via Jet...
            If Left(dbsProsper.Connect, 5) = "ODBC;" And InStr(1, dbsProsper.Connect, ".mdb") Then
                'Use Jet to connect
                tdfLinked.Connect = ";DATABASE=" & GetConnectParam(dbsProsper.Connect, "DBQ")
            Else
                'Use ODBC to connect
                tdfLinked.Connect = dbsProsper.Connect
                tdfLinked.Attributes = dbAttachSavePWD
            End If
            
            tdfLinked.SourceTableName = strTableName
            ThisMDB.TableDefs.Append tdfLinked
            
            'Set global gIsRelationshipsDirty variable so that all
            'table relationships will later get recreated
            gIsRelationshipsDirty = True
            gintLinkCount = gintLinkCount + 1
        End If
        
        Set tdfLinked = Nothing
    Else
        ' Create a link that points to a table in Prosper SQL Server database.
        Set tdfLinked = ThisMDB.CreateTableDef(strTableName)
        With tdfLinked
            'If the Prosper ODBC database is Access (not SQL server) then
            'don't connect via ODBC, connect via Jet...
            If Left(dbsProsper.Connect, 5) = "ODBC;" And InStr(1, dbsProsper.Connect, ".mdb") Then
                .Connect = ";DATABASE=" & GetConnectParam(dbsProsper.Connect, "DBQ")
            Else
                .Connect = dbsProsper.Connect
                .Attributes = dbAttachSavePWD
            End If
            
            .SourceTableName = strTableName
            ThisMDB.TableDefs.Append tdfLinked
        End With
        
        Set tdfLinked = Nothing
        gintLinkCount = gintLinkCount + 1
    End If

    Exit Function
    
LinkError:
        MsgBox "Error linking table: " & strTableName & vbCrLf & Err.Description
        
        If Not tdfLinked Is Nothing Then
            Set tdfLinked = Nothing
            Set ThisMDB = Nothing
        End If
        
        End
End Function

'Reads a parameter from a connection string (which are normally terminated with a semicolon or nothing at end of string)
'Eg: GetConnectParam("ODBC;Database=C:\MyDb;UID=Admin", "Database") returns C:\MyDb
Function GetConnectParam(strConnect As String, strParam As String) As String
    On Error Resume Next
    Dim intParamPos As String
    intParamPos = InStr(1, strConnect, strParam) + Len(strParam) + 1 'the 1 is for the '=' sign
    If intParamPos > 0 Then
        
        'If this is the last paramaeter, it may not be semicolon terminated
        'in which case read to the end of string
        If InStr(intParamPos, strConnect, ";") = 0 And intParamPos < Len(strConnect) Then
            GetConnectParam = Mid$(strConnect, intParamPos)
        Else
            'else read to 1 character before the next semicolon
            GetConnectParam = Mid$(strConnect, intParamPos, InStr(intParamPos, strConnect, ";") - intParamPos)
        End If
    Else
        GetConnectParam = ""
    End If
End Function

'Used by form frmReports and Sub Startup() to lock and unlock this database:
Sub LockDB(blnLock As Boolean)
    On Error Resume Next
    If blnLock = True Then
        ChangeProperty "StartupShowDBWindow", dbBoolean, False
        ChangeProperty "AllowBreakIntoCode", dbBoolean, False
        ChangeProperty "AllowSpecialKeys", dbBoolean, False
        ChangeProperty "AllowBypassKey", dbBoolean, False
        'ChangeProperty "StartupShowStatusBar", dbBoolean, False
        'ChangeProperty "AllowBuiltinToolbars", dbBoolean, False
        'ChangeProperty "AllowFullMenus", dbBoolean, False
    Else
        ChangeProperty "StartupShowDBWindow", dbBoolean, True
        ChangeProperty "AllowBreakIntoCode", dbBoolean, True
        ChangeProperty "AllowSpecialKeys", dbBoolean, True
        ChangeProperty "AllowBypassKey", dbBoolean, True
        'ChangeProperty "StartupShowStatusBar", dbBoolean, True
        'ChangeProperty "AllowBuiltinToolbars", dbBoolean, True
        'ChangeProperty "AllowFullMenus", dbBoolean, True
    End If
End Sub

'Used by Sub LockDB() to change database properties:
Function ChangeProperty(strPropName As String, varPropType As Variant, varPropValue As Variant) As Integer
    Dim dbs As Database, prp As Property
    Const conPropNotFoundError = 3270

    Set dbs = CurrentDb
    On Error GoTo Change_Err
    dbs.Properties(strPropName) = varPropValue
    ChangeProperty = True

Change_Exit:
    Exit Function

Change_Err:
    If Err = conPropNotFoundError Then  ' Property not found.
        Set prp = dbs.CreateProperty(strPropName, _
                  varPropType, varPropValue)
        dbs.Properties.Append prp
        Resume Next
    Else
        ' Unknown error.
        ChangeProperty = False
        Resume Change_Exit
    End If
    
End Function

'Used by Sub Startup() to check for a previous version of PRM
'in the same direcory as this db. Any reports found in any database
'that matches "PRM*.mdb" will be presented for importing
'via form "frmImportReports"
Public Function ImportReports()
   ' Exit Function  ' who needs this any ways - often caused an error
    On Error GoTo Import_Error
    Dim strThisAppPath As String, i As Integer, strtemp As String
    Dim strThisAppName As String, strEarlierAppName As String
    'Reset counter for no of Reports imported
    gintReportImportCount = 0
    
    'If InStr(1, CurrentDb.Name, "PRM", vbTextCompare) = 0 Then
     '   MsgBox "This database (" & CurrentDb.Name & ") has been renamed!" & vbCrLf & _
     '   "The first 3 letters of any PRM database must be 'PRM'"
     '   Quit
    'Else
        strThisAppName = Mid$(CurrentDb.Name, InStr(1, CurrentDb.Name, "PRM", vbTextCompare))
    
    For i = 1 To 20
    
        If Left$(Right$(Command, i), 1) = "\" Then
        strThisAppPath = Left$(Command, Len(Command) - i + 1)
        i = 99
        End If
        
    Next i
   
    i = 0
    'Put path of all PRM databases into string array gstrPRMNames()
    strEarlierAppName = Dir(strThisAppPath & "PRM?????.MDB")
    If Len(strEarlierAppName) > 4 Then
    Do
        If strEarlierAppName <> "" Then
            If strEarlierAppName <> strThisAppName Then
                i = i + 1
                ReDim Preserve gstrPRMNames(1 To i) As String
                gstrPRMNames(i) = strThisAppPath & strEarlierAppName
            End If
        End If
        strEarlierAppName = Dir
    Loop Until strEarlierAppName = ""
    End If
    If i < 1 Then
        ImportReports = False
        Exit Function
    Else
        ImportReports = True
        DoCmd.OpenForm "frmImportReports", , , , , acDialog
    End If
    
    Exit Function
Import_Error:
    MsgBox "Error in ImportReports():" & vbCrLf & Err.Description
   
End Function

Open in new window

0
 
Jim Dettman (Microsoft MVP/ EE MVE)PresidentCommented:
From what's there, I don't see any reason it could not be converted to a Jet based workspace object.

Jim.
0
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
ITdiamondAuthor Commented:
Is there a converter out there for this, or is this something I am going to have to pay to have done ie) through freelancer.com or so forth?

The original manufacturer no longer supports this software.
0
 
Jim Dettman (Microsoft MVP/ EE MVE)PresidentCommented:
As I said, a through review of the code is required.  

 The work required may range from nothing more than changing the workspace to a Jet based one and changing a few lines of code, to making significant changes to the point of almost re-writing the app.

 For example, if they choose to use ODBCDirect for the feature of running queries asynchronously or working with multiple record sets at a time, then you have to look at why and how that would impact the app and it would most likely mean changing the fundamental logic of how it operates.

 If the entire code that needs to be looked at is what you posted, than we can probably work through it here in a reasonable time frame.   But I'm guessing there is an entire app that needs to be looked at and not just this one piece.

 In short it's doable, but chances are it's not something that is going to be simple or fast.  

Jim.
0
 
ITdiamondAuthor Commented:
I don't believe they are pulling asynchronously.  Its a pretty simple report builder based on data in SQL on the back end database.  I would have to install an old machine with Access Run Time 2000 to see all the combinations to see if it would be easier to rewrite in Crystal Reports.  However if this can just be a few lines to change the workspace to a jet based one, I am just not aware of the proper syntax.

I do know that if I comment out line 93: Set wrkODBC = CreateWorkspace("NewODBCWorkspace", "admin", "", dbUseODBC)
that eliminates the error message but "Object variable or With block variable not set" is the new error message instead.

So to me this seems like maybe it has to do with this line?

I don't know, I'm not an ms access guru.
0
 
Jim Dettman (Microsoft MVP/ EE MVE)PresidentCommented:
Instead of:

   Set wrkODBC = CreateWorkspace("NewODBCWorkspace", "admin", "", dbUseODBC)
   
    'Open READ-ONLY connection object based on information entered in DSN.
    Set dbsProsper = wrkODBC.OpenConnection("ProsperWorkspace", _
        dbDriverNoPrompt, True, "ODBC;UID=" & gstrUID & ";PWD=" & gstrPWD & ";DSN=" & gstrDSN & ";")
   
    'Link or Re-link all tables specified in gstrTableList if any are unattached or DSN is changed
    i = 1
    Do
        strTempTable = CGeneral.ParseString(gstrTableList, ",", i)
        varReturn = SysCmd(acSysCmdSetStatus, "Linking Table " & strTempTable)
        If strTempTable <> "" Then
            LinkTable strTempTable
            i = i + 1
        End If
    Loop Until strTempTable = ""
   
    'Close Temporary workspace/database object
    dbsProsper.Close: Set dbsProsper = Nothing
    wrkODBC.Close: Set wrkODBC = Nothing

You would do:

       Dim wrkJet as Workspace

        ' Create Microsoft Jet Workspace object.
      Set wrkJet = CreateWorkspace("", "admin", "", dbUseJet)

       'Open READ-ONLY connection object based on information entered in DSN.
       Set dbsProsper = wrkJet.OpenDatabase(gstrDSN , dbDriverNoPrompt, True, "ODBC;UID=" & gstrUID & ";PWD=" & gstrPWD & ";")
   
    'Link or Re-link all tables specified in gstrTableList if any are unattached or DSN is changed
    i = 1
    Do
        strTempTable = CGeneral.ParseString(gstrTableList, ",", i)
        varReturn = SysCmd(acSysCmdSetStatus, "Linking Table " & strTempTable)
        If strTempTable <> "" Then
            LinkTable strTempTable
            i = i + 1
        End If
    Loop Until strTempTable = ""
   
    'Close Temporary workspace/database object
    dbsProsper.Close
   Set dbsProsper = Nothing

    wrkJET.Close
    Set wrkJET = Nothing
0
 
ITdiamondAuthor Commented:
You are a genius.  That works. perfectly!

I think you helped me on the right path between the code examples and searching the net.  Its great to learn something every day.  Thank you so much for your help!
0
 
ITdiamondAuthor Commented:
Jim Dettman is an asset to the Experts Exchange community.  He tries to explain and elaborate and then takes precious time to show code examples or rewrite sections of code if needed.  He deserves free access to Experts Exchange!
0
 
Jim Dettman (Microsoft MVP/ EE MVE)PresidentCommented:
Thanks for the kind words.  

I would however point out that the code I posted is not optimized.  From what I see, at this point there really is no need to create a separate workspace object.   Instead, you could use the default one.

 However when I'm suggesting code changes and may not have the full picture, I make suggestions along the lines of changing as little as possible rather than refactoring everything.

 There's nothing wrong with what I suggested, but it could be faster (were probably talking less than a second by the way).

Jim.
0

Featured Post

Free Backup Tool for VMware and Hyper-V

Restore full virtual machine or individual guest files from 19 common file systems directly from the backup file. Schedule VM backups with PowerShell scripts. Set desired time, lean back and let the script to notify you via email upon completion.  

  • 5
  • 5
Tackle projects and never again get stuck behind a technical roadblock.
Join Now