refreshed linked tables

Save the following code as a module, then add an autoexec macro as described below:

'***********************************Module code ***************
Option Compare Database   'Use database order for string comparisons
Option Explicit

'File Open/Save structures and declarations *****************************


Type OPENFILENAME
       lStructSize As Long         'Same
       hwndOwner As Long           'Was Integer
       hInstance As Long           'Was Integer
       lpstrFilter As String       'Was Long
       lpstrCustomFilter As String 'Was Long
       nMaxCustFilter As Long      'Same
       nFilterIndex As Long        'Same
       lpstrFile As String         'Was Long
       nMaxFile As Long            'Same
       lpstrFileTitle As String    'Was Long
       nMaxFileTitle As Long       'Same
       lpstrInitialDir As String   'Was Long
       lpstrTitle As String        'Was Long
       Flags As Long               'Same
       nFileOffset As Integer      'Same
       nFileExtension As Integer   'Same
       lpstrDefExt As String       'Was Long
       lCustData As Long           'Same
       lpfnHook As Long            'Same
       lpTemplateName As String    'Was long
End Type


Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME)
As Long


Public Const OFN_ALLOWMULTISELECT = &H200      'See Help Note for LFN Behavior
Public Const OFN_CREATEPROMPT = &H2000
Public Const OFN_ENABLEHOOK = &H20
Public Const OFN_ENABLETEMPLATE = &H40
Public Const OFN_ENABLETEMPLATEHANDLE = &H80
Public Const OFN_EXPLORER = &H80000            'Windows 95 Only
Public Const OFN_EXTENSIONDIFFERENT = &H400
Public Const OFN_FILEMUSTEXIST = &H1000
Public Const OFN_HIDEREADONLY = &H4
Public Const OFN_LONGNAMES = &H200000          'Windows 95 Only
Public Const OFN_NOCHANGEDIR = &H8
Public Const OFN_NODEREFERENCELINKS = &H100000 'Windows 95 Only
Public Const OFN_NOLONGNAMES = &H40000         'Not Referenced in Help!
Public Const OFN_NONETWORKBUTTON = &H20000
Public Const OFN_NOREADONLYRETURN = &H8000
Public Const OFN_NOTESTFILECREATE = &H10000
Public Const OFN_NOVALIDATE = &H100
Public Const OFN_OVERWRITEPROMPT = &H2
Public Const OFN_PATHMUSTEXIST = &H800
Public Const OFN_READONLY = &H1
Public Const OFN_SHAREAWARE = &H4000
Public Const OFN_SHAREFALLTHROUGH = 2
Public Const OFN_SHARENOWARN = 1
Public Const OFN_SHAREWARN = 0
Public Const OFN_SHOWHELP = &H10
' These represent the possible returns errors from API.
Public Const ERROR_BAD_DEVICE = 1200&
Public Const ERROR_CONNECTION_UNAVAIL = 1201&
Public Const ERROR_EXTENDED_ERROR = 1208&
Public Const ERROR_MORE_DATA = 234
Public Const ERROR_NOT_SUPPORTED = 50&
Public Const ERROR_NO_NET_OR_BAD_PATH = 1203&
Public Const ERROR_NO_NETWORK = 1222&
Public Const ERROR_NOT_CONNECTED = 2250&
Public Const NO_ERROR = 0

' This API declaration is used to return the
' UNC path from a drive letter.
Declare Function WNetGetConnection Lib "mpr.dll" Alias _
                "WNetGetConnectionA" _
                (ByVal lpszLocalName As String, _
                ByVal lpszRemoteName As String, _
                cbRemoteName As Long) As Long
Public Function FindFile(Infile As String) As String
   
   Dim tagOPENFILENAME As OPENFILENAME
   Dim hwnd As Long, result As Long
   Dim szTitle As String, szFile As String * 256, szFilter As String
   Dim file As String, szFilename As String

   'szFile = String$(128, 0)
   szFilter = "Access Files" & Chr$(0) & "*.mdb" & Chr$(0) & "All Files (*.*)" & Chr$(0) & "*.*" & 
Chr$(0) & Chr$(0)
   If Infile = "" Then
       szTitle = "Select the required File" & Chr$(0)
       szFile = Chr$(0)
   Else
       szTitle = "Where is " & Infile & "?" & Chr$(0)
       szFile = Infile & Chr$(0)
   End If
     
   tagOPENFILENAME.lStructSize = Len(tagOPENFILENAME)
   tagOPENFILENAME.hwndOwner = Application.hWndAccessApp
   tagOPENFILENAME.Flags = OFN_FILEMUSTEXIST Or OFN_HIDEREADONLY Or OFN_PATHMUSTEXIST
   tagOPENFILENAME.nFilterIndex = 1
   tagOPENFILENAME.nMaxFile = 256
   tagOPENFILENAME.lpstrFile = szFile
   tagOPENFILENAME.lpstrFilter = szFilter
   tagOPENFILENAME.lpstrTitle = szTitle
   tagOPENFILENAME.lpstrInitialDir = AppPath() & Chr$(0)
   result = GetOpenFileName(tagOPENFILENAME)
   If result = 0 Then Exit Function

   file = left$(tagOPENFILENAME.lpstrFile, InStr(tagOPENFILENAME.lpstrFile, Chr$(0)) - 1)
   FindFile = file
End Function
Function AreTablesAttached(dbname As String, Maxtables As Long, TableName As String) As Integer
   '  Update connection information in attached tables.
   '
   '  Number of attached tables for progress meter.
   Const NONEXISTENT_TABLE = 3011
   Const DATA_NOT_FOUND = 3024
   Const ACCESS_DENIED = 3051
   Const READ_ONLY_DATABASE = 3027
   
   Dim TableCount As Long
   Dim FileName As String, SearchPath As String, temp As String
   Dim ReturnValue As Variant, AccDir As String, i As Integer
   Dim MyTable As TableDef, MyDbfile As String
   Dim sTemp As String
   Dim myDB As Database, MyRecords As Recordset
   Set myDB = DBEngine.Workspaces(0).Databases(0)
   MyDbfile = Trim$(dbname) & ".mdb"
   AreTablesAttached = True

   '  Continue if attachments are broken.
   On Error Resume Next
   '  Open attached table to see if connection information is correct.
   Set MyRecords = myDB.OpenRecordset(TableName)
   '  Exit if connection information is correct.
   If Err = 0 Then
     MyRecords.Close
     Exit Function
   End If

   '  Initialize progress meter.
   StartMeter "Attaching tables", Maxtables
   
   '  Get name of directory where MSACCESS.EXE is located.
   
   SearchPath = SysCmd(acSysCmdAccessDir)
   
   If (Dir$(SearchPath & MyDbfile) = "") Then
       FileName = FindFile(MyDbfile)             ' Display Open File dialog.
       FileName = Trim(FileName)
       If FileName = "" Then GoTo Exit_Failed ' User pressed Cancel.
   Else
       FileName = SearchPath & MyDbfile
   End If
   FileName = ConvertToUNC(FileName)
   ' Loop through all tables, reattaching those with nonzero-length Connect strings.
   TableCount = 1  ' Initialize TableCount for status meter.
   For i = 0 To myDB.TableDefs.Count - 1
       Set MyTable = myDB.TableDefs(i)
       sTemp = MyTable.Name
       If MyTable.Connect <> "" Then
           MyTable.Connect = ";DATABASE=" & FileName
           Err = 0
           MyTable.RefreshLink
           If Err <> 0 Then
              If Err = NONEXISTENT_TABLE Then
                 MsgBox "File '" & FileName & "' does not contain required table '" & MyTable.SourceTableName
& "'", vbCritical + vbOKOnly, "Can't Run System"
              ElseIf Err = DATA_NOT_FOUND Then
                 MsgBox "You can't run the system until you locate the Database", vbCritical + vbOKOnly,
"Can't Run System"
              ElseIf Err = ACCESS_DENIED Then
                 MsgBox "Couldn't open " & FileName & " because it is read-only or it is located on
a read-only share.", vbCritical + vbOKOnly, "Can't Run System"
              ElseIf Err = READ_ONLY_DATABASE Then
                 MsgBox "Can't reattach tables because the Database is read-only or is located on a
read-only share.", vbCritical + vbOKOnly, "Can't Run System"
              Else
                 MsgBox Error, vbCritical + vbOKOnly, "Can't Run the System"
              End If
              AreTablesAttached = False
              GoTo Exit_Final
           End If
           TableCount = TableCount + 1
           UpdateMeter TableCount
       End If
   Next i

   GoTo Exit_Final

Exit_Failed:
   MsgBox "You can't run the system until you locate " & UCase$(dbname) & ".MDB", vbCritical + vbOKOnly,
"Can't Run the System"
   AreTablesAttached = False

Exit_Final:
   ClearMeter
End Function
Function GetUNCPath(strDriveLetter As String) As String
  On Local Error GoTo GetUNCPath_Err

  Dim Msg As String, lngReturn As Long
  Dim lpszLocalName As String
  Dim lpszRemoteName As String
  Dim cbRemoteName As Long
  lpszLocalName = strDriveLetter
  lpszRemoteName = String$(255, Chr$(32))
  cbRemoteName = Len(lpszRemoteName)
  lngReturn = WNetGetConnection(lpszLocalName, lpszRemoteName, cbRemoteName)
  Select Case lngReturn

  Case NO_ERROR
       GetUNCPath = left$(lpszRemoteName, InStr(lpszRemoteName, Chr$(0)) - 1)
  Case Else
       GetUNCPath = strDriveLetter
  End Select
 
GetUNCPath_End:
  Exit Function
GetUNCPath_Err:
  MsgBox Err.Description, vbInformation
  Resume GetUNCPath_End
End Function
Public Sub StartMeter(sPrompt As String, ByVal lMaxRecs As Long)
Dim iRet As Integer
   iRet = SysCmd(acSysCmdInitMeter, sPrompt, lMaxRecs)
End Sub

Public Sub UpdateMeter(ByVal lRecVal As Long)
Dim iRet As Integer
   iRet = SysCmd(acSysCmdUpdateMeter, lRecVal)
End Sub

Public Sub ClearMeter()
Dim iRet As Integer
   iRet = SysCmd(acSysCmdRemoveMeter)
End Sub

Public Function ConvertToUNC(ByVal sFileName As String) As String
Dim sDrive As String, sPath As String, sUNC As String
If Mid$(sFileName, 2, 1) = ":" Then
   sDrive = left$(sFileName, 2)
   sPath = Mid$(sFileName, 3)
   sUNC = GetUNCPath(sDrive)
   If sUNC <> sDrive Then sFileName = sUNC & sPath
End If
ConvertToUNC = sFileName
End Function

Public Function AppPath() As String
On Error GoTo AppPath_err
   Dim r As Integer
   Dim s As String
   Dim db As Database
   Set db = CurrentDb()
   s = db.Name
   For r = Len(s) To 1 Step -1
       If Mid$(s, r, 1) = "\" Then
           AppPath = left$(s, r)
           Exit Function
       End If
   Next r
AppPath_Exit:
   AppPath = ""
   Exit Function

AppPath_err:
   MsgBox "Error: " + Error$, vbOKOnly, "AppPath"
   Resume AppPath_Exit

End Function
'******************end of module *******************


'***************Autoexec macro *************************

Condition:

NotAreTablesAttached("Database file name",NumberOfTables,"Name of a table")

Action:  Quit  Options:  Exit

Next Line:

Action:  OpenForm   Options:  Name of the form to open

when i need to relink linked tables in access I use
Docmd.TransferDatabase acLink

This did not work :(

Can't I have a command button and do it there? What i would like to do is like the one that access does (Linked Table Manager). Thanks!

well you could build your own form which would conatin a list of your linked tables (you can prgammaticly determine whether their linked or not) and place a check nxt to each entry.

palce a command button on the form which will relink the tables where the check is true.

Hello Datrias!I tried that one and I got this message:

Run-time error '2507'
The type isn't an installed database type or doesn't support the operation you chose.

Hope you still can help me figure out something.

Thanks!

Datrias, I need the code asap. I don't have enought time to code it because I will still have to study to come up with the code to refresh those sql linked tables.

Datrias, I need the code asap. I don't have enought time to code it because I will still have to study to come up with the code to refresh those sql linked tables.

ok ok
cool ur jets !

what exactly do u need ?

Datrias, I need the code asap. I don't have enought time to code it because I will still have to study to come up with the code to refresh those sql linked tables.

for an ODBC datasource

DoCmd.TransferDatabase acLink, "ODBC", "ODBC;DATABASE=YourDB;YourODBCConectionString", acTable, "SourceTable", "DestinationTable", False


OK ?

ops, sori about repeated postings. i didn't know that.

anyway, what i need is just like what the msaccess' linked table manager does. so everytime i change dsn, i wouldnt have to open the window and go on tools, refresh linked tables etc... what i want to do is click a button and then it will ask me for the dsn and then refreshes the linked tables. hope i explain it clear this time.

thanks.

jean

sorry typo above

DoCmd.TransferDatabase acLink, "ODBC", "ODBC","YourDB","YourODBCConectionString", acTable, "SourceTable",
"DestinationTable", False

\sorry again  typo above

DoCmd.TransferDatabase acLink, "ODBC","YourDB","YourODBCConectionString", acTable, "SourceTable",

"DestinationTable", False

how are the tables linked - ODBC ?

will it always be the same server and the same database?

have u got a list of linked tables and will they change ?

ops, sori about repeated postings. i didn't know that.

anyway, what i need is just like what the msaccess' linked table manager does. so everytime i change dsn, i wouldnt have to open the window and go on tools, refresh linked tables etc... what i want to do is click a button and then it will ask me for the dsn and then refreshes the linked tables. hope i explain it clear this time.

thanks.

jean

so create a loop to loop through each of your linked tables
and use the docmd.transferdatabase method to relink the tables.

where is the problem ?????????????????????????

i just hope you'll give me the code coz i don't have time to make it and i need it asap. i could do the code but it will take me sometime.

thanks anyway...

Question(s) below appears to have been abandoned. Your options are:
 
1. Accept a Comment As Answer (use the button next to the Expert's name).
2. Close the question if the information was not useful to you. You must tell the participants why you wish to do this, and allow for Expert response.
3. Ask Community Support to help split points between participating experts, or just comment here with details and we'll respond with the process.
4. Delete the question. Again, please comment to advise the other participants why you wish to do this.

For special handling needs, please post a zero point question in the link below and include the question QID/link(s) that it regards.
https://www.experts-exchange.com/jsp/qList.jsp?ta=commspt
 
Please click the Help Desk link on the left for Member Guidelines, Member Agreement and the Question/Answer process.  https://www.experts-exchange.com/jsp/cmtyHelpDesk.jsp

Please click you Member Profile to view your question history and keep them all current with updates as the collaboration effort continues, to track all your open and locked questions at this site.  If you are an EE Pro user, use the Power Search option to find them.

To view your open questions, please click the following link(s) and keep them all current with updates.
https://www.experts-exchange.com/questions/Q.20142188.html
https://www.experts-exchange.com/questions/Q.20182272.html
https://www.experts-exchange.com/questions/Q.20189903.html
https://www.experts-exchange.com/questions/Q.20239368.html
https://www.experts-exchange.com/questions/Q.11674518.html
https://www.experts-exchange.com/questions/Q.11939899.html
https://www.experts-exchange.com/questions/Q.11940858.html
https://www.experts-exchange.com/questions/Q.20157957.html
https://www.experts-exchange.com/questions/Q.20074994.html
https://www.experts-exchange.com/questions/Q.20142188.html
https://www.experts-exchange.com/questions/Q.20182272.html
https://www.experts-exchange.com/questions/Q.20189903.html
https://www.experts-exchange.com/questions/Q.20239368.html
https://www.experts-exchange.com/questions/Q.11674518.html
https://www.experts-exchange.com/questions/Q.11939899.html
https://www.experts-exchange.com/questions/Q.11940858.html
https://www.experts-exchange.com/questions/Q.20157957.html




PLEASE DO NOT AWARD THE POINTS TO ME.  
 
------------>  EXPERTS:  Please leave any comments regarding your closing recommendations if this item remains inactive another seven (7) days.  Also, if you are interested in the cleanup effort, please click this link https://www.experts-exchange.com/jsp/qManageQuestion.jsp?ta=commspt&qid=20274643
 
Thank you everyone.
 
Moondancer
Moderator @ Experts Exchange

P.S.  For any year 2000 questions, special attention is needed to ensure the first correct response is awarded, since they are not in the comment date order, but rather in Member ID order.

Admin notified of User neglect. Force-accepted by
Netminder
CS Moderator