Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Function RefreshLinkedTables() As Long
'Reattach linked tables according to setting in config.ini
'Contents Config.ini file:
'[System]
'Database = "D:\Work\ApplicationName\BE_DATA\Application_BE.mdb"
Dim tdef As TableDef, sLink As String, sOldLink As String
Dim strPath As String
On Error GoTo Err_RefreshLinkedTables
strPath = GetFromConfig("System", "Database", vbNullString)
If strPath = vbNullString Then
MyMsgBox "Configuration file doesn't exist or is invalid.", vbExclamation
Else
For Each tdef In DBEngine(0)(0).TableDefs
sOldLink = tdef.Connect
If Len(sOldLink) > 0 Then 'Table is linked
If InStr(sOldLink, "database=") > 0 Then 'An attached table
If InStr(sOldLink, "Excel") = 0 Then 'Attached table is an Excel spreadsheet
sLink = ";DATABASE=" & strPath 'Create connection string
If sOldLink <> sLink Then ' different from original?
tdef.Connect = sLink 'Set new link
tdef.RefreshLink
End If
End If
End If
End If
Next tdef
End If
Exit_RefreshLinkedTables:
Exit Function
Err_RefreshLinkedTables:
If Err.Number = 3024 Then Resume Next ' Couldn't find file
MsgBox Err.Description
RefreshLinkedTables = Err.Number
GoTo Exit_RefreshLinkedTables
Resume
End Function
Public Function GetFromConfig(ByVal Section As String, ByVal Key As String, ByVal Default As String)
GetFromConfig = GetKeyValueFromINI(StripPath(CurrentDb.name) & "\Config.ini", Section, Key, Default)
End Function
Public Function GetKeyValueFromINI(ByVal vstrIniFile As String, ByVal vstrSection As String, ByVal vstrKey As String, Optional ByVal vstrDefault As String) As String
Dim lstrBuffer As String
Dim llngRet As Long
Dim lstrResult As String
lstrBuffer = Space(255)
llngRet = GetPrivateProfileString(vstrSection, vstrKey, "", lstrBuffer, Len(lstrBuffer), vstrIniFile)
If llngRet <> 0 Then
lstrResult = TrimNull(lstrBuffer)
Else
lstrResult = vstrDefault
End If
GetKeyValueFromINI = lstrResult
End Function
Public Function StripPath(strFilename As String) As String
'Return path without filename
'Getpart at http://www.access-programmers.co.uk/forums/showthread.php?t=175633&highlight=getpart
Dim intX As Integer
Dim intMax As Integer
Dim strResult As String
intMax = GetParts(strFilename, "\")
strResult = ""
For intX = 1 To intMax - 1
strResult = strResult & GetPart(strFilename, "\", intX) & "\"
Next intX
StripPath = strResult
End Function
