[Access VBA] Kiểm tra link table và relink nếu file gốc bị thay đổi

[nguoiconxunui]

Hôm rồi lấy cái file cũ ra xem, người ta sử dụng link table:
Như thế này:
- Khi mở files RunAPP (file dùng để chạy chương trình) nếu không thấy link table thì cho chọn lại DB để link
-Hoặc file BD bị thay đổi, di chuyển cũng thông báo luôn và làm như trên:
1. Thủ tục link table:

Public Sub linkAllTbles()
    Dim tdf As TableDef
    Dim i As Integer
    Dim lDB As String
    Dim sqltext As String
    Set db = CurrentDb
    lDB = GetOpenFile ' đường dẫn db (function này có thể tìm trên net)
    On Error Resume Next
    
    For i = 0 To db.TableDefs.Count - 1
        Set tdf = db.TableDefs(i)
        If tdf.Properties(4) <> "" Then
            If Left(tdf.Name, 4) <> "MSys" Then 'bỏ qua table hệ thống
                DoCmd.DeleteObject acTable, tdf.Name 'xóa linked table
            End If
        End If
    Next i
    Set tdf = Nothing
    Set db = Nothing
    Set db = DBEngine.Workspaces(0).OpenDatabase(lDB)
        For i = 0 To db.TableDefs.Count - 1
        Set tdf = db.TableDefs(i)
        If Left(tdf.Name, 4) <> "MSys" Then ' bỏ qua table hệ thống
            DoCmd.TransferDatabase acLink, "Microsoft Access", lDB, acTable, tdf.Name, tdf.Name
        End If
    Next i
    Set tdf = Nothing
    Set db = Nothing
End Sub

2. Thủ tục kiểm tra

Public Sub CheckLinkTbales()
    Dim strTest As String, db As Database
    Dim td As TableDef, MyStr

    Set db = CurrentDb
    For Each td In db.TableDefs
        If Len(td.Connect) > 0 Then ' nếu các table đã link
        strTest = Dir(Mid(td.Connect, 11)) ' Kiểm tra đường dẫn có đùng không?
            If Len(strTest) = 0 Then ' Nếu không đúng! thì cho hiện hộp thoại thông báo.
                If MsgBox("Database not found: " & Mid(td.Connect, 11) & Chr(13) + Chr(10) & "Do you want to reconnect to new DB?", vbYesNo, "Waring") = vbYes Then
                Call linkAllTbles ' gọi thủ tục link ở trên
                Else
    Exit For ' nếu người dùng chọn no thì thoát vòng lặp
                End If
            End If
            Else ' Nếu chưa có link trước đó thì không cần kiểm tra mà cho hiện thông báo luôn
                If MsgBox("Database not found: " & Mid(td.Connect, 11) & Chr(13) + Chr(10) & "Do you want to reconnect to new DB?", vbYesNo, "Waring") = vbYes Then
                Call linkAllTbles
                Exit For ' link xong cho thoát vòng lặp vì trong MS acess còn một mớ table hệ thống ,nó check cho hết mới dừng thấy bực mình
                Else
    Exit For ' ngược lại chọn No thì cũng thoát vòng lặp
                End If
        End If
    Next ' cái này để duyệt hết các table
Exit Sub
End Sub

----------
-Sưu tầm