( TableDefs RefreshLink )
|
|
, 01 2014 . 00:54
+
, , :
_ - ,
__ () ( ),
_ - ( ),
__ -
, , ..
- TableDefsRefreshLink()
splash-
Option Compare Database
Option Explicit
Public Function TableDefsRefreshLink()
Dim a As Variant, b As New Collection
'
For Each a In f1()
If a(2) Then '
'
If Not f3(a, b) Then '
' ?
If a(3) Then
MsgBox " " & a(1) & " '" & a(0) & "'"
Else
MsgBox " '" & a(0) & "' " & a(1)
End If
'
b.Add f2(a)
'
If Not f3(a, b) Then
' - Quit
MsgBox " '" & b(b.Count) & "' '" & a(0) & "', "
Quit
End If
End If
End If
Next
End Function
Private Function f1() As Collection
Dim a As New Collection
With CurrentDb.OpenRecordset("SELECT ForeignName, Database FROM msysobjects WHERE Database Is Not Null;", dbOpenForwardOnly)
While Not .EOF
a.Add Array(!ForeignName.Value, !Database.Value, f5(!ForeignName.Value), Not CBool(Len(Dir(!Database.Value))))
.MoveNext
Wend
.Close
End With
Set f1 = a
End Function
Private Function f2(a) As String
Dim b As FileDialog
Static c As String
If Len(c) = 0 Then c = CurrentProject.Path & "\"
Set b = FileDialog(msoFileDialogOpen): With b
.InitialFileName = c
.InitialView = msoFileDialogViewList
.AllowMultiSelect = False
.Title = " '" & a(0) & "' (.:" & a(1) & ")"
.Filters.Clear
.Filters.Add "Access Databases", "*.mdb"
.Filters.Add "All Files", "*.*"
If .Show = True Then
c = f4(.SelectedItems(1))
f2 = .SelectedItems(1)
Else
MsgBox " , "
Quit
End If
End With: Set b = Nothing
End Function
Private Function f3(a, b) As Boolean
Dim c As Variant, d As String
With CurrentDb
For Each c In b
With .TableDefs(a(0))
If Len(d) = 0 Then d = .Connect
.Connect = Replace(d, a(1), c)
On Error Resume Next
.RefreshLink
If Err.Number = 0 Then
f3 = True
Exit Function
End If
On Error GoTo 0
End With
Next
End With
End Function
Private Function f4(a As String) As String
f4 = Left(a, InStrRev(a, "\"))
End Function
Private Function f5(a As String) As Boolean
Dim b As Recordset
On Error Resume Next
Set b = CurrentDb.OpenRecordset(a)
f5 = CBool(Err.Number)
Set b = Nothing
On Error GoTo 0
End Function
http://www.sql.ru/forum/1129753/avtomaticheskaya-perelinkovka-svyazannyh-tablic-tabledefs-refreshlink
