Here is some code to refresh manage code in ADO/Access. Requires
"Microsoft ActiveX Data Objects 2.5 Library" as well as "Microsoft ADO
Ext. 2.5 for DDL and Security" references in the code.
I developed it as there seemed to be nothing out there that I could
google, only the DAO version that was getting somewhat dated.
Option Compare Database
Option Explicit
Const IntAttachedTableType As Integer = 6
Function fRefreshLinks(strPath As String) As Boolean
Dim strOldConnect As String, strNewConnect As String
Dim strFullLocation As String, strDatabase As String, strMsg As
String
Dim cnn As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim MyDB As New ADOX.Catalog
Dim MyTable As ADOX.Table
MyDB.ActiveConnection = CurrentProject.Connection
Set cnn = CurrentProject.Connection
rst.Open "SELECT MSysObjects.Connect, MsysObjects.Database,
MSysObjects.Name from MSysObjects " & _
"WHERE MSysObjects.Type = " & IntAttachedTableType, cnn,
adOpenDynamic, adLockReadOnly
If rst.RecordCount <> 0 Then
rst.MoveFirst
On Error GoTo fRefreshLinks_Err
Set MyTable = MyDB.Tables(rst![Name].Value)
strOldConnect = MyTable.Properties(IntAttachedTableType).Value
strNewConnect = strPath
For Each MyTable In MyDB.Tables
If MyTable.Properties(IntAttachedTableType).Value =
strOldConnect Then
MyTable.Properties(IntAttachedTableType).Value =
strNewConnect
End If
Next MyTable
MyDB.Tables.Refresh
End If
fRefreshLinks_End:
rst.Close
cnn.Close
Set cnn = Nothing
Set rst = Nothing
Set MyDB = Nothing
Set MyTable = Nothing
fRefreshLinks = True
Exit Function
fRefreshLinks_Err:
fRefreshLinks = False
Select Case Err
Case 3024:
Case Else:
strMsg = "Error Information..." & vbCrLf & vbCrLf
strMsg = strMsg & "Function: fRefreshLinks" & vbCrLf
strMsg = strMsg & "Description: " & Err.Description &
vbCrLf
strMsg = strMsg & "Error #: " & Format$(Err.Number) &
vbCrLf
MsgBox strMsg, vbOKOnly + vbCritical, "Error"
End Select
Exit Function
End Function
Public Function FileName(strFullLocation As String)
Dim intlen As Integer, i As Integer
'Get the Database Name, for use on the 'Find File' Form Caption
intlen = Len(strFullLocation)
For i = intlen To 1 Step -1
If Mid$(strFullLocation, i, 1) = "\" Then
FileName = Right$(strFullLocation, intlen - i)
Exit For
End If
Next i
End Function
