Delete Then Relink Tables!

[tomcat21]

I have code to relink tables to the front end from a command button on my switchboard. It deletes all table, then relinks all tables; but you have to know the path.
I also have code to automatically look for the back end on startup, but it only links tables. I would like for the code to be adjusted to automatically Delete and then relink all tables on Startup without knowing the path.

How can I adjust the following code?
Also, if any code is provided, eaxctly how do I call it? Would I paste it into existing code, etc.

Thanks.

CODE START
Option Explicit
Option Compare Database

Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
"GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Boolean
Declare Function GetSaveFileName Lib "comdlg32.dll" Alias _
"GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Boolean

Declare Function FindWindow Lib "user32" Alias _
"FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As Long) As Long

Declare Function SendMessage Lib "user32" Alias _
"SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long

Type MSA_OPENFILENAME
strFilter As String
lngFilterIndex As Long
strInitialDir As String
strInitialFile As String
strDialogTitle As String
strDefaultExtension As String
lngFlags As Long
strFullPathReturned As String
strFileNameReturned As String
intFileOffset As Integer
intFileExtension As Integer
End Type

Const ALLFILES = "All Files"

Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As Long
nMaxCustrFilter 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
lCustrData As Long
lpfnHook As Long
lpTemplateName As Long
End Type

Const OFN_ALLOWMULTISELECT = &H200
Const OFN_CREATEPROMPT = &H2000
Const OFN_EXPLORER = &H80000
Const OFN_FILEMUSTEXIST = &H1000
Const OFN_HIDEREADONLY = &H4
Const OFN_NOCHANGEDIR = &H8
Const OFN_NODEREFERENCELINKS = &H100000
Const OFN_NONETWORKBUTTON = &H20000
Const OFN_NOREADONLYRETURN = &H8000
Const OFN_NOVALIDATE = &H100
Const OFN_OVERWRITEPROMPT = &H2
Const OFN_PATHMUSTEXIST = &H800
Const OFN_READONLY = &H1
Const OFN_SHOWHELP = &H10

Function MSA_CreateFilterString(ParamArray varFilt() As Variant) As String
Dim strFilter As String
Dim intRet As Integer
Dim intNum As Integer
intNum = UBound(varFilt)
If (intNum <> -1) Then
For intRet = 0 To intNum
strFilter = strFilter & varFilt(intRet) & vbNullChar
Next
If intNum Mod 2 = 0 Then
strFilter = strFilter & "*.*" & vbNullChar
End If
strFilter = strFilter & vbNullChar
Else
strFilter = ""
End If
MSA_CreateFilterString = strFilter
End Function

Function MSA_ConvertFilterString(strFilterIn As String) As String
Dim strFilter As String
Dim intNum As Integer, intPos As Integer, intLastPos As Integer
strFilter = ""
intNum = 0
intPos = 1
intLastPos = 1
Do
intPos = InStr(intLastPos, strFilterIn, "|")
If (intPos > intLastPos) Then
strFilter = strFilter & Mid(strFilterIn, intLastPos, intPos - intLastPos) & vbNullChar
intNum = intNum + 1
intLastPos = intPos + 1
ElseIf (intPos = intLastPos) Then
intLastPos = intPos + 1
End If
Loop Until (intPos = 0)
intPos = Len(strFilterIn)
If (intPos >= intLastPos) Then
strFilter = strFilter & Mid(strFilterIn, intLastPos, intPos - intLastPos + 1) & vbNullChar
intNum = intNum + 1
End If
If intNum Mod 2 = 1 Then
strFilter = strFilter & "*.*" & vbNullChar
End If
If strFilter <> "" Then
strFilter = strFilter & vbNullChar
End If
MSA_ConvertFilterString = strFilter
End Function

Private Function MSA_GetSaveFileName(msaof As MSA_OPENFILENAME) As Integer
Dim of As OPENFILENAME
Dim intRet As Integer
MSAOF_tF msaof, of
of.flags = of.flags Or OFN_HIDEREADONLY
intRet = GetSaveFileName(of)
If intRet Then
OF_to_MSAOF of, msaof
End If
MSA_GetSaveFileName = intRet
End Function

Function MSA_SimpleGetSaveFileName() As String
Dim msaof As MSA_OPENFILENAME
Dim intRet As Integer
Dim strRet As String
intRet = MSA_GetSaveFileName(msaof)
If intRet Then
strRet = msaof.strFullPathReturned
End If
MSA_SimpleGetSaveFileName = strRet
End Function

Private Function MSA_GetOpenFileName(msaof As MSA_OPENFILENAME) As Integer
Dim of As OPENFILENAME
Dim intRet As Integer
MSAOF_tF msaof, of
intRet = GetOpenFileName(of)
If intRet Then
OF_to_MSAOF of, msaof
End If
MSA_GetOpenFileName = intRet
End Function

Private Sub OF_to_MSAOF(of As OPENFILENAME, msaof As MSA_OPENFILENAME)
msaof.strFullPathReturned = Left(of.lpstrFile, InStr(of.lpstrFile, vbNullChar) - 1)
msaof.strFileNameReturned = of.lpstrFileTitle
msaof.intFileOffset = of.nFileOffset
msaof.intFileExtension = of.nFileExtension
End Sub

Private Sub MSAOF_tF(msaof As MSA_OPENFILENAME, of As OPENFILENAME)
Dim strFile As String * 512
of.hwndOwner = Application.hWndAccessApp
of.hInstance = 0
of.lpstrCustomFilter = 0
of.nMaxCustrFilter = 0
of.lpfnHook = 0
of.lpTemplateName = 0
of.lCustrData = 0
If msaof.strFilter = "" Then
of.lpstrFilter = MSA_CreateFilterString(ALLFILES)
Else
of.lpstrFilter = msaof.strFilter
End If
of.nFilterIndex = msaof.lngFilterIndex
of.lpstrFile = msaof.strInitialFile _
& String(512 - Len(msaof.strInitialFile), 0)
of.nMaxFile = 511
of.lpstrFileTitle = String(512, 0)
of.nMaxFileTitle = 511
of.lpstrTitle = msaof.strDialogTitle
of.lpstrInitialDir = msaof.strInitialDir
of.lpstrDefExt = msaof.strDefaultExtension
of.flags = msaof.lngFlags
of.lStructSize = Len(of)
End Sub

Public Function RelinkTables() As Boolean
On Error Resume Next
Const conNonExistentTable = 3011
Const conNotconEEC3Data = 3078
Const conEEC3DataNotFound = 3024
Const conAccessDenied = 3051
Const conReadOnlyDatabase = 3027
Const conNotValidPath = 3044
Const conDiskNetworkError = 3043
Const conAppTitle = "ApplicationName" 'edit this
Dim strSearchPath As String
Dim strFileName As String
Dim strError As String
Dim strDatabase As String
Dim frm_ActiveForm As Form
Dim msg As String
Set frm_ActiveForm = Screen.ActiveForm
strDatabase = "ApplicationName_be.mdb" 'type in the name of the DB to link to
strSearchPath = "C:\My Documents\" 'type in the default search directory
Err.Clear
Err_strSearchPath:
If (Dir(strSearchPath & strDatabase) <> "") Then
strFileName = strSearchPath & strDatabase
Else
msg = "Couldn't find shared data for " & conAppTitle & " ."
msg = msg & "You must locate " & strDatabase & "."
msg = msg & " Are you connected to the Network?"
MsgBox msg, vbInformation, "Refresh Links"
strFileName = FindSharedData(strSearchPath)
If strFileName = "" Then
strError = "Sorry, you must locate " & strDatabase & " to open " & conAppTitle & "."
GoTo Exit_Failed
End If
End If
frm_ActiveForm.Repaint
If RefreshLinks(strFileName) Then
RelinkTables = True
Exit Function
End If
If Err = conNotValidPath Or Err = conDiskNetworkError Or Err = conEEC3DataNotFound Then
strSearchPath = "S:\" ' type in what you want to be an alternative search direcory
GoTo Err_strSearchPath
End If
Select Case Err
Case conNonExistentTable, conNotconEEC3Data
strError = "File '" & strFileName & "' does not contain the required " & strDatabase & " ."
Case Err = conEEC3DataNotFound
strError = "You can't run " & conAppTitle & " until you locate " & strDatabase & " ."
Case Err = conAccessDenied
strError = "Couldn't open " & strFileName & " because it is read-only or located on a read-only share."
Case Err = conReadOnlyDatabase
strError = "Can't reattach tables because " & conAppTitle & " is read-only or is located on a read-only share."
Case Else
strError = Err.Description
End Select
Exit_Failed:
MsgBox "Table Links Error", vbCritical, conAppTitle
RelinkTables = False
End Function

Function FindSharedData(strSearchPath) As String
On Error Resume Next
Dim msaof As MSA_OPENFILENAME
msaof.strDialogTitle = "Where is the file named ApplicationName_be.mdb?" 'edit this to you Back End DB name
msaof.strInitialDir = strSearchPath
msaof.strFilter = MSA_CreateFilterString("Access Databases", "*.mdb;*.mde")
MSA_GetOpenFileName msaof
FindSharedData = Trim(msaof.strFullPathReturned)
End Function

Function MSA_SimpleGetOpenFileName() As String
On Error Resume Next
Dim msaof As MSA_OPENFILENAME
Dim intRet As Integer
Dim strRet As String
intRet = MSA_GetOpenFileName(msaof)
If intRet Then
strRet = msaof.strFullPathReturned
End If
MSA_SimpleGetOpenFileName = strRet
End Function

Public Function CheckLinks() As Boolean
On Error Resume Next
Dim dbs As Database, rst As Recordset
Set dbs = CurrentDb()
Set rst = dbs.OpenRecordset("TableName") 'type in a linked table name here
If Err = 0 Then
CheckLinks = True
Else
CheckLinks = False
End If
End Function

Private Sub OF_to_MSAOF1(of As OPENFILENAME, msaof As MSA_OPENFILENAME)
On Error Resume Next
msaof.strFullPathReturned = Left$(of.lpstrFile, InStr(of.lpstrFile, Chr$(0)))
msaof.strFileNameReturned = of.lpstrFileTitle
msaof.intFileOffset = of.nFileOffset
msaof.intFileExtension = of.nFileExtension
End Sub

Private Function RefreshLinks(strFileName As String) As Boolean
On Error Resume Next
Dim dbs, dbsRefresh As Database
Dim intCount As Integer
Dim tdf As TableDef
Set dbsRefresh = OpenDatabase(strFileName, False, False, "; pwd=") 'edit this if db is passworded (pwd=)
Set dbs = CurrentDb()
For intCount = 0 To dbs.TableDefs.Count - 1
Set tdf = dbs.TableDefs(intCount)
If Len(tdf.Connect) > 0 Then
tdf.Connect = ";DATABASE=" & strFileName
Err = 0
On Error Resume Next
tdf.RefreshLink
If Err <> 0 Then
RefreshLinks = False
Exit Function
End If
End If
Next intCount
dbsRefresh.Close
DoCmd.OpenForm "FormSwitchboard" 'edit this to your "Switchboard" or startup form.
DoCmd.Echo True, ""
RefreshLinks = True
End Function

Function Autoexec()
On Error Resume Next
If CheckLinks() = False Then
If RelinkTables() = False Then
DoCmd.Quit acExit
End If
End If
End Function
END CODE

Thomas Bailey

http://www.reportcop.com

tomcat@reportcop.com

 

[firstdivision]

I'll admit that I didn't read all that code, but before trying to write my own, I'd look into maybe using the linked table manager somehow. It seems that many of the menu entries available in Access are also available through the docmd command.

Worth a shot...


AB

 

[Scroggie]

Try this

http://www.peterssoftware.com/tlk.htm

 

[Page410]

If you don't use the link table manager you could always query against MSysObjects to get the table path before you delete the table and then use the path to re-create your link.

This sql will return the name and path for tables linked to other Access DB's
SELECT MSysObjects.Name, MSysObjects.Database
FROM MSysObjects
WHERE (((MSysObjects.Type)=6));

Here is sql to return the name and connection string for linked odbc tables
SELECT MSysObjects.Name, MSysObjects.Connect
FROM MSysObjects
WHERE (((MSysObjects.Type)=4));