Results 1 to 3 of 3
  1. #1
    Join Date
    Apr 2004
    Posts
    130

    Unanswered: Error in trying to relink in vba

    I am trying to relink a backend table in vba. Got this code from a book. The remove link works just fine. The refreshlink gives an error at the line

    tdf.Properties("Jet OLEDB:Link Datasource") = strNewLocation

    Error is
    Runtime error '91':
    "Object Variable or With block variable not set"
    WinXP Pro
    Access 2002

    Anyone with any ideas

    Thanks
    Winston


    Option Compare Database
    Option Explicit

    Private Sub RemoveLink_Click()
    On Error GoTo Err_RemoveLink_Click
    Dim cat As Catalog
    'Instantiate a Catalog object
    Set cat = New ADOX.Catalog
    'Point the ActiveConnection property
    cat.ActiveConnection = CurrentProject.Connection
    cat.Tables.Delete ("tblReports")
    Exit_RemoveLink_Click:
    Exit Sub
    Err_RemoveLink_Click:
    MsgBox Err.Description
    Resume Exit_RemoveLink_Click
    End Sub

    Private Sub RefreshLink_Click()
    On Error GoTo Err_RefreshLink_Click
    'Initiate error handling
    On Error GoTo RefreshLink_Err
    Dim cat As ADOX.Catalog
    Dim tdf As ADOX.Table
    Dim strNewLocation As String
    Dim strTemp As String
    'Instantiate a Catalog object
    Set cat = New ADOX.Catalog
    'Set the ActiveConnection property of the Catalog
    'object to the connection associated with the
    'current project
    Set cat.ActiveConnection = CurrentProject.Connection
    'Point the TableeDef object at the tblReports table
    Set tdf = cat.Tables("tblReports")
    'Attempt to retrieve the Name property of the table
    strTemp = tdf.Columns(0).Name
    'Exit the routine if all goes well
    Exit Sub
    RefreshLink_Err:
    'If an error occurs, try hard coding
    strNewLocation = "C:\Data.mdb"
    'Set the properties of the TableDef object to hard coded value
    tdf.Properties("Jet OLEDB:Link Datasource") = strNewLocation
    Set cat.ActiveConnection = CurrentProject.Connection
    Set tdf = cat.Tables("tblReports")
    'Try to grab the name property again
    Resume
    Exit_RefreshLink_Click:
    Exit Sub
    Err_RefreshLink_Click:
    MsgBox Err.Description
    Resume Exit_RefreshLink_Click
    End Sub

  2. #2
    Join Date
    Jan 2004
    Location
    Islamabad, Pakistan
    Posts
    97
    Here is the sample code which I use normally to link, unlink and refresh links in my databases...

    you can use these functions with database file path as the parameter for linkdatabase() and refreshlinks()

    eg. LinkDatabase "C:\MyDocuments\mydatabase.mdb"

    **************

    Sub RemoveLinks()
    Dim tdf As TableDef
    For Each tdf In CurrentDb.TableDefs
    If Left(tdf.Name, 4) <> "MSys" And (tdf.Attributes And dbAttachedTable) = dbAttachedTable Then
    CurrentDb.TableDefs.Delete tdf.Name
    End If
    Next tdf
    Set tdf = Nothing
    End Sub

    Sub LinkDatabase(StrDBPath As String)
    Dim dbs As Database
    Dim tdf As TableDef
    Set dbs = OpenDatabase(StrDBPath)
    For Each tdf In dbs.TableDefs
    If Left(tdf.Name, 4) <> "MSys" Then
    DoCmd.TransferDatabase acLink, "Microsoft Access", Trim(StrDBPath), acTable, tdf.Name, tdf.Name
    SysCmd acSysCmdSetStatus, "Processing table [" & tdf.Name & "]..."
    End If
    Next tdf
    SysCmd acSysCmdClearStatus
    Set dbs = Nothing
    Set tdf = Nothing
    End Sub

    Sub RefreshLinks(StrDBPath As String)
    Dim tdf As TableDef
    For Each tdf In CurrentDb.TableDefs
    If (tdf.Attributes And dbAttachedTable) = dbAttachedTable Then
    tdf.Connect = "; Database = " & StrDBPath
    SysCmd acSysCmdSetStatus, "Processing table [" & tdf.Name & "]..."
    tdf.RefreshLink
    End If
    Next tdf
    Set tdf = Nothing
    SysCmd acSysCmdClearStatus
    End Sub

  3. #3
    Join Date
    Apr 2004
    Posts
    130

    Smile Works like a charm!

    Thank you very much]
    Winston

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •