Click here to Skip to main content
15,895,011 members
Please Sign up or sign in to vote.
1.00/5 (1 vote)
See more:
Dear Experts,
I am trying to find a vba code in access which on prompt refresh and relinks the SQLite tables, having both front-end and back-end databases on same machine, the following code from Dev Ashish (Access mvp)works fine for Access-Access links, but I cannot configure it to work for Access-SQLite table links,I am a basic user and need help to work it out. thanks

Code from Dev Ashish:
VB
'***************** Code Start ***************
' This code was originally written by Dev Ashish.
' It is not to be altered or distributed,
' except as part of an application.
' You are free to use it in any application,
' provided the copyright notice is left unchanged.
'
' Code Courtesy of
' Dev Ashish
'
Function fRefreshLinks() As Boolean
Dim strMsg As String, collTbls As Collection
Dim i As Integer, strDBPath As String, strTbl As String
Dim dbCurr As DATABASE, dbLink As DATABASE
Dim tdfLocal As TableDef
Dim varRet As Variant
Dim strNewPath As String

Const cERR_USERCANCEL = vbObjectError + 1000
Const cERR_NOREMOTETABLE = vbObjectError + 2000

    On Local Error GoTo fRefreshLinks_Err

    If MsgBox("Are you sure you want to reconnect all Access tables?", _
            vbQuestion + vbYesNo, "Please confirm...") = vbNo Then Err.Raise cERR_USERCANCEL

    'First get all linked tables in a collection
    Set collTbls = fGetLinkedTables

    'now link all of them
    Set dbCurr = CurrentDb

    strMsg = "Do you wish to specify a different path for the Access Tables?"
    
    If MsgBox(strMsg, vbQuestion + vbYesNo, "Alternate data source...") = vbYes Then
        strNewPath = fGetMDBName("Please select a new datasource")
    Else
        strNewPath = vbNullString
    End If

    For i = collTbls.Count To 1 Step -1
        strDBPath = fParsePath(collTbls(i))
        strTbl = fParseTable(collTbls(i))
        varRet = SysCmd(acSysCmdSetStatus, "Now linking '" & strTbl & "'....")
        If Left$(strDBPath, 4) = "ODBC" Then
            'ODBC Tables
            'ODBC Tables handled separately
           ' Set tdfLocal = dbCurr.TableDefs(strTbl)
           ' With tdfLocal
           '     .Connect = pcCONNECT
           '     .RefreshLink
           '     collTbls.Remove (strTbl)
           ' End With
        Else
            If strNewPath <> vbNullString Then
                'Try this first
                strDBPath = strNewPath
            Else
                If Len(Dir(strDBPath)) = 0 Then
                    'File Doesn't Exist, call GetOpenFileName
                    strDBPath = fGetMDBName("'" & strDBPath & "' not found.")
                    If strDBPath = vbNullString Then
                        'user pressed cancel
                        Err.Raise cERR_USERCANCEL
                    End If
                End If
            End If

            'backend database exists
            'putting it here since we could have
            'tables from multiple sources
            Set dbLink = DBEngine(0).OpenDatabase(strDBPath)

            'check to see if the table is present in dbLink
            strTbl = fParseTable(collTbls(i))
            If fIsRemoteTable(dbLink, strTbl) Then
                'everything's ok, reconnect
                Set tdfLocal = dbCurr.TableDefs(strTbl)
                With tdfLocal
                    .Connect = ";Database=" & strDBPath
                    .RefreshLink
                    collTbls.Remove (.Name)
                End With
            Else
                Err.Raise cERR_NOREMOTETABLE
            End If
        End If
    Next
    fRefreshLinks = True
    varRet = SysCmd(acSysCmdClearStatus)
    MsgBox "All Access tables were successfully reconnected.", _
            vbInformation + vbOKOnly, _
            "Success"

fRefreshLinks_End:
    Set collTbls = Nothing
    Set tdfLocal = Nothing
    Set dbLink = Nothing
    Set dbCurr = Nothing
    Exit Function
fRefreshLinks_Err:
    fRefreshLinks = False
    Select Case Err
        Case 3059:

        Case cERR_USERCANCEL:
            MsgBox "No Database was specified, couldn't link tables.", _
                    vbCritical + vbOKOnly, _
                    "Error in refreshing links."
            Resume fRefreshLinks_End
        Case cERR_NOREMOTETABLE:
            MsgBox "Table '" & strTbl & "' was not found in the database" & _
                    vbCrLf & dbLink.Name & ". Couldn't refresh links", _
                    vbCritical + vbOKOnly, _
                    "Error in refreshing links."
            Resume fRefreshLinks_End
        Case Else:
            strMsg = "Error Information..." & vbCrLf & vbCrLf
            strMsg = strMsg & "Function: fRefreshLinks" & vbCrLf
            strMsg = strMsg & "Description: " & Err.Description & vbCrLf
            strMsg = strMsg & "Error #: " & Format$(Err.Number) & vbCrLf
            MsgBox strMsg, vbOKOnly + vbCritical, "Error"
            Resume fRefreshLinks_End
    End Select
End Function

Function fIsRemoteTable(dbRemote As DATABASE, strTbl As String) As Boolean
Dim tdf As TableDef
    On Error Resume Next
    Set tdf = dbRemote.TableDefs(strTbl)
    fIsRemoteTable = (Err = 0)
    Set tdf = Nothing
End Function

Function fGetMDBName(strIn As String) As String
'Calls GetOpenFileName dialog
Dim strFilter As String

    strFilter = ahtAddFilterItem(strFilter, _
                    "Access Database(*.mdb;*.mda;*.mde;*.mdw) ", _
                    "*.mdb; *.mda; *.mde; *.mdw")
    strFilter = ahtAddFilterItem(strFilter, _
                    "All Files (*.*)", _
                    "*.*")

    fGetMDBName = ahtCommonFileOpenSave(Filter:=strFilter, _
                                OpenFile:=True, _
                                DialogTitle:=strIn, _
                                Flags:=ahtOFN_HIDEREADONLY)
End Function

Function fGetLinkedTables() As Collection
'Returns all linked tables
    Dim collTables As New Collection
    Dim tdf As TableDef, db As DATABASE
    Set db = CurrentDb
    db.TableDefs.Refresh
    For Each tdf In db.TableDefs
        With tdf
            If Len(.Connect) > 0 Then
                If Left$(.Connect, 4) = "ODBC" Then
                '    collTables.Add Item:=.Name & ";" & .Connect, KEY:=.Name
                'ODBC Reconnect handled separately
                Else
                    collTables.Add Item:=.Name & .Connect, Key:=.Name
                End If
            End If
        End With
    Next
    Set fGetLinkedTables = collTables
    Set collTables = Nothing
    Set tdf = Nothing
    Set db = Nothing
End Function

Function fParsePath(strIn As String) As String
    If Left$(strIn, 4) <> "ODBC" Then
        fParsePath = Right(strIn, Len(strIn) _
                        - (InStr(1, strIn, "DATABASE=") + 8))
    Else
        fParsePath = strIn
    End If
End Function

Function fParseTable(strIn As String) As String
    fParseTable = Left$(strIn, InStr(1, strIn, ";") - 1)
End Function
'***************** Code End ***************
Posted
Updated 1-Aug-15 16:26pm
v4
Comments
RedDk 1-Aug-15 19:40pm    
I suspect that this isn't very helpful but SQLite via VBA code in Access is not the route you want to take to connect to database tables. That said, I would rewrite all these tables usg SQL Server and install SQL Server Management Studio 2008 Express R2 Sp2 with Advanced Services and do the translation manually. Access (the MS Database platform, not the MVP Dev Ashish web thingumbob) is robustly capable of doing SQL Server duty and has VBA as it's coding front-end.


In other words, do yourself a favor. Installing the SSMSE is real easy and upgrades are available usg Windows Update, fully detected on your Windows box.

And while you're downloading the SSMSE, download the BOL for it as well. Tons of fun programming in TSQL. If you've got time download the AdventureWorks databases too. Many samples in the BOL refer to this huge implementation of the understandable language of TSQL.
Member 11879062 2-Aug-15 12:05pm    
RedDK, Thanks for your reply, this is an other approach, but it would be preferable a solution through VBA, as I had a setup working with Access front-end/ back-end databases, now we have changed our back-end database to SQLite3, and we need to alter database name and path every now and then, currently I have relinked all tables manually to our current SQLite version, but want to be able to relink all these same tables to a different SQLite database in different path with a control on a Form when needed.
RedDk 3-Aug-15 13:35pm    
Alright.

Frankly I can't understand why you would distance yourself from the language created by the shippers of the database. But in today's world x-platform operations should be easy due to Google search.

On a note, might be helpful in your quest to fill in the space between the boulders you've piled in SQLite3, there's GDAL and QGIS and GPSBabel, all freeware, numerous others out there, which provide up-front conversion schemes betwen SQLServer and SQLite file types. Once you're VBA macros have expanded ...

1 solution

I have found the solution searching by Google, TableLinker module created by "Peter's Software" does what exactly I required, anyone interested please visit http://www.peterssoftware.com.

 
Share this answer
 
Comments
PIEBALDconsult 5-Aug-15 11:13am    
Please don't answer your own question; just use "Improve question" to add this there.

This content, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)



CodeProject, 20 Bay Street, 11th Floor Toronto, Ontario, Canada M5J 2N8 +1 (416) 849-8900