To relocate all the Link tables!!

[Fekri]

Hi,

To change the location of linked tables, I have which will relocate them.
But in the Network, it takes time a lot. specially to relocate the tables which have many records.

So, I found If the linked tables delete and to make new linked tables with new location, it can do in network very faster than relocate them.

So, If I want to delete all linked tables and make new linked tables with new location, What I have to do????


Thanks
Ali

 

[randy700]

Try this function I used some time back...

Public Function RelinkTables()
'This function recreates the links to tables in the new.mdb database. Links are
'first removed to prevent the possibility of duplicating tables.
    Dim tdf As TableDef
    Dim i As Integer, j As Integer
    Dim strBackEnd As String
    If MsgBox("Relink all tables?", vbYesNo + vbQuestion, strTitle) = vbNo Then
        Exit Function
    End If
    strBackEnd = ap_FileOpen("Locate QC.mdb")
    Forms!frmAdminStuff!lblRelink.Visible = True
    Set db = CurrentDb()
    On Error Resume Next
    DoCmd.Hourglass True
    For i = 0 To db.TableDefs.Count - 1
        Set tdf = db.TableDefs(i)
        If tdf.Properties(4) <> "" Then
            If Left(tdf.Name, 4) <> "msys" Then
                DoCmd.DeleteObject acTable, tdf.Name
            End If
        End If
    Next i
    Set tdf = Nothing
    Set db = Nothing
    Set db = DBEngine.Workspaces(0).OpenDatabase(strBackEnd)
    j = 0
    For i = 0 To db.TableDefs.Count - 1
        Set tdf = db.TableDefs(i)
        If Left(tdf.Name, 4) <> "msys" Then
            DoCmd.TransferDatabase acLink, "Microsoft Access", strBackEnd, acTable, _
                tdf.Name, tdf.Name
        Else
            j = j + 1
        End If
    Next i
    DoCmd.Hourglass False
    MsgBox db.TableDefs.Count - j & " tables relinked.", vbOKOnly + vbInformation, _
        strTitle
    Set tdf = Nothing
    Set db = Nothing
    blnCompact = True
    strSQL = "UPDATE tblDatabaseInformation " & _
        "SET Drive = '" & strDrive & "' " & _
        "WHERE ID = 1"
    ProcessQuery (strSQL)
    Forms!frmAdminStuff!lblRelink.Visible = False
End Function

Randy

 

[formerTexan]

Ali,

The following link will get you underway with deleting linked tables.

http://support.microsoft.com/kb/210307

And below is a simple procedure to relink. You will have to supply a valid path.

Dim Dbs As DAO.Database
Dim Tdf As DAO.TableDef
Dim Tdfs As DAO.TableDefs
Dim strPath As String

Set Dbs = CurrentDb
Set Tdfs = Dbs.TableDefs
strPath = ""
For Each Tdf In Tdfs
Tdf.Connect = ";DATABASE=" & strPath 'Set the new source
Tdf.RefreshLink 'Refresh the link
Next Tdf

Cheers,
Bill

 

[Fekri]

Thanks to you,

I'm trying both ways but in first:

Randy I got error in this line:
strBackEnd = ap_FileOpen("Locate QC.mdb")
which error highlighted on "ap_FileOpen".
Error description: Sub ot method not found


What I did wrong?
Ali

 

[randy700]

You need to substitute the name of YOUR database in place of mine.


Randy

 

[PHV]

Randy, you didn't provide the code of the ap_FileOpen function ...

 

[Fekri]

Yes I did it like this:

strBackEnd = ap_FileOpen("C:\Program Files\AKAF System\Database\1385.mdb")

But still the error is coming:

Sub or Function not defined.

("ap_FileOpen" highlighted in above line)

thanks
Ali

 

[randy700]

Sorry.....

Option Compare Database
Option Explicit

Private Declare Function ap_GetOpenFileName Lib "comdlg32.dll" Alias _
    "GetOpenFileNameA" (pOpenFileName As OPENFILENAME) As Long
    
Private Type OPENFILENAME
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type

Public Function ap_FileOpen(Optional strTitle As String = "Open File", _
        Optional strFileName As String = "", _
        Optional strFilter As String = "") As String
    Dim OpenFile As OPENFILENAME
    Dim lngReturn As Long
    
    If Len(strFileName) = 0 Then
        strFileName = String(255, 0)
    End If
    If Len(strFilter) = 0 Then
        strFilter = "Access databases(*.mdb)" & Chr(0) & "*.mdb" & Chr(0)
    End If
    
    OpenFile.lStructSize = Len(OpenFile)
    OpenFile.lpstrFilter = strFilter
    OpenFile.nFilterIndex = 1
    OpenFile.lpstrFile = strFileName + Space(255 - Len(strFileName))
    OpenFile.nMaxFile = 255
    OpenFile.lpstrFileTitle = strFileName
    OpenFile.nMaxFileTitle = OpenFile.nMaxFile
    OpenFile.lpstrInitialDir = "C:\"
    OpenFile.lpstrTitle = strTitle
    OpenFile.flags = 0
    ap_GetOpenFileName OpenFile
    ap_FileOpen = Left(OpenFile.lpstrFile, InStr(OpenFile.lpstrFile, Chr$(0)) - 1)
End Function

Randy

 

[Fekri]

Thanks Randy But,

I got error in this line:

ProcessQuery (strSQL)

you didn't provide the code of the "ProcessQuery" function
again.

Thanks
ALi

 

[randy700]

Public Function ProcessQuery(strSQL)
'This function accepts the string argument and uses it to process the query.
    Dim db2 As DAO.Database
    Dim qDef2 As DAO.QueryDef
    Set db2 = CurrentDb
    Set qDef2 = db2.CreateQueryDef("", strSQL)
    qDef2.Execute
    Set qDef2 = Nothing
    Set db2 = Nothing
End Function

Randy

 

[Fekri]

Thanks again,

But this time error on this "strTitle" in the following line in first code which you posted:
If MsgBox("Relink all tables?", vbYesNo + vbQuestion, strTitle) = vbNo Then

I made a command button and "=RelinkTables()" in onclick event.

Is it right? or I have to do some else?

Thanks
Ali

 

[randy700]

In most of my applications, I like to have the name of the application appear in the header area of message boxes. To preclude the necessity of typing it every time, I use a public variable, strTitle, that is set as a constant. You can substitute anything you want in place of my string variable.


Randy

 

[Fekri]

error again:

Set db = CurrentDb()
db highlighted and error: Variable not found

Ali

 

[PHV]

Fekri, please, stop acting as a cargo cult programmer ;-)
Simply add the following:
Dim db As Database

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886

 

[Fekri]

You are right PHV,

I'm tired too.
I did to add Dim db as Database before I make question again but when I saw more than 10 error comes out, I thought that is mistake and should be another.

Randy, Your posted code has many variable which not substitue still and I could not use it.
I ashamed to ask you again to correct it because I'm loosing other people time to read this thread..

Thanks and I will find somewhere else what I want.

Thanks
Ali

 

[randy700]

Fekri,

This code was provided to me a few years ago by one of my co-workers. I made changes that fit my application and it has worked well for me. I believe that if you take a little time with it, you will be able to convert it to fit your needs as well. Good luck....


Randy