(12-05-17, 10:07 PM)ongke0711 Đã viết:

(12-05-17, 08:11 PM)ledangvan Đã viết: Hì, khôngđược Dân à, nó báo là số bảng trong hệ thống là 4 trong File link là 2 -> Lỗi
Anh chỉ muốn nó kết nối lại thôi chứ không muốn nó xóa bảng ở trong File gốc.
Anh làm một phần mềm bao gồm : Phần chạy và phần dữ liệu
Phần chạy bao gồm các bảng : Bảng không link và bảng link từ bảng dữ liệu
Nếu xử lý như Em hướng dẫn nó sẽ xóa tất cả các File trên phần chạy rồi tạo lại Link -> Như vậy một số bảng cần cho phần chạy nó xóa luôn ...

Để không xóa table thì anh sửa chút xíu trong đoạn code của Function TaoLinkTable(). Chỉ xóa những table nào là Linked table thôi (tabledefs.Connect >0).

---------------------
...
If KiemtraTableTontai(DatTenLinkTable) Then
        If CurrentDb.TableDefs(DatTenLinkTable).Connect > 0 Then
            CurrentDb.TableDefs.Delete DatTenLinkTable
        End If
End If
...

Cảm ơn Ongke vẫn không được bởi vì theo thực tế file của anh thì aa luôn >=bb; nếu đảo ngược so với Dân bảo anh sửa thì nó lại xảy ra lỗi không như ý muốn : Nó sẽ kết nối với File chứa số bảng <= số bảng của File chính : Ví dụ File chính bao gồm 4 bảng : A,B,C,D trong đó A,B là 2 bảng link -> Khi kết nối với một data có chứa 1 bảng A thì nó cũng chấp nhận link nhưng nó xóa mất B
Anh muốn là khi kết nối nó sẽ không xóa mà chỉ xem Data có chứa bảng như bảng link ở File chính hay không rồi nó relink chứ không tạo lại link. Hoặc là nó chỉ cần so sánh các bảng link của File chính với bảng của file Data cần kết nối.

Gửi anh một cách tiếp cận khác cho việc cập nhật lại Linked Tables. Không bị xóa mất Table. Hy vọng đáp ứng đúng nhu cầu của anh.

Link file demo:http://www.mediafire.com/file/j666qh46ul...Tables.rar

Kịch bản nó như sau:
-
- Khi ứng dụng khởi động sẽ chạy 1 form khởi động (Splash form). Form nay sẽ check các tất cả các linked table (đường dẫn) có còn sống không (chỉ kiểm tra table nào link thôi)? Nếu có vấn đề sẽ tự động link lại. Sau đó sẽ đóng form Splash và gọi form Login.
- Thứ nhất nó sẽ kiểm tra xem có tìm thấy file database (.mdb) có còn ở đúng vị trí như trong dường dẫn hay không? (Có thể bị đổi tên). Nếu bị đổi tên hoặc đổi vị trí thì sẽ hiện hộp thoại để chọn lại đường dẫn. Sau đó sẽ Relink lại.
- Thứ hai nó sẽ kiểm tra các table có còn kết nối với file back-end không? Nếu không cũng sẽ relink lại. Nếu phát sinh trường hợp không có tên table nào đó trong file BE, nõ sẽ hiện thông báo tên table nào bị mất để tự sửa chửa rồi đóng ứng dụng lại. Tại sao có thêm cái kiểm thứ 2 này: vì có trường hợp file dữ liệu back-end thì đúng rồi nhưng bị xóa mất table hoặc đổi tên table, nếu không thêm đoạn code này chương trình kiểm tra vẫn thấy file .mdb đúng rồi nên không re-link lại nữa -> lỗi một vài table như vậy.

Do vậy anh có thể tự thử nghiệm các trường hợp như sau:
- Đổi tên file .mdb back-end.
- Đổi tên table trong file BE.
- Tạo các thêm các table, xóa table ở file BE để test.

Module Code cho việc này:
- Tạo 1 Standard module đặt tên là basCheckLinkedTables, copy đoạn code dưới đây vào.

Mã PHP:

Option Explicit
[/font]

Dim BrokenLinkTbls As New Collection
Public strPath As String

Public Sub AppendTables()
 On Error GoTo errLbl:
   Dim db As DAO.Database, x As Variant
   Dim strTest As String
   ' Them ten cac Table bi loi ket noi vao BrokenLinkTbls Collection.
   Set db = CurrentDb
   ClearAll
   For Each x In db.TableDefs
       If Len(x.Connect) > 1 And Len(Dir(Mid(x.Connect, 11))) = 0 Then
       'Co chuoi ket noi nhung khong co file mdb
            BrokenLinkTbls.Add Item:=x.Name, Key:=x.Name
       End If
   Next
   Exit Sub
errLbl:
  If Err.Number = 52 Then
  MsgBoxUni "Không có k" & ChrW(7871) & "t n" & ChrW(7889) & "i trong Network."
  For Each x In db.TableDefs
       If Len(x.Connect) > 1 Then
       'MsgBox x.Name & " " & x.Connect
       ' connect string exists, but file does not
        BrokenLinkTbls.Add Item:=x.Name, Key:=x.Name
       End If
   Next
  Else
    'Call ErrHandler(Err.Number, Err.Description, "Error in Appendtables")
  End If
End Sub

Public Function ProcessTables()

   Dim strTest As String
   On Error GoTo Err_BeginLink

   'Them vao BrokenLinkTbls cac tables bi loi ket noi
   AppendTables

   'Kiem tra duong dan ket noi
   strTest = strPath

   On Error GoTo Err_BeginLink
   If Len(strTest) = 0 Then   'Không tìm thay file hoac ban không chon file mdb nao.
       MsgBoxUni "Không tìm th" & ChrW(7845) & "y file d" & ChrW(7919) & " li" & ChrW(7879) & "u (.mdb, .accdb)." & vbCrLf & _
                 "Hãy th" & ChrW(7917) & " k" & ChrW(7871) & "t n" & ChrW(7889) & "i l" & ChrW(7841) & "i.", vbExclamation, "K" & ChrW(7871) & "t n" & ChrW(7889) & "i t" & ChrW(7899) & "i file d" & ChrW(7919) & " li" & ChrW(7879) & "u"
       Exit Function
   End If

   ' Bat dau Relink lai cac Tables
   Relinktables (strTest)
   ' Kiem tra lan nua các table da link chua.
   CheckifComplete

   DoCmd.Echo True, "Done"
   If BrokenLinkTbls.Count < 1 Then
       MsgBoxUni "Link t" & ChrW(7899) & "i file d" & ChrW(7919) & " li" & ChrW(7879) & "u Back-end thành công."
   Else
       MsgBoxUni "Còn table ch" & ChrW(432) & "a k" & ChrW(7871) & "t n" & ChrW(7889) & "i thành công v" & ChrW(7899) & "i file d" & ChrW(7919) & " li" & ChrW(7879) & "u Back-end."
   End If


Exit_BeginLink:
   DoCmd.Echo True
   Exit Function

Err_BeginLink:
   Debug.Print Err.Number
   If Err.Number = 457 Then
       ClearAll
       Resume Next
   ElseIf Err.Number = 3043 Then
       MsgBox "Can not find the Master on the Network.  Check that you have a good network connection."
       Resume Exit_BeginLink
   Else
       'Call ErrHandler(Err.Number, Err.Description, "Error in Processtables")
       Resume Exit_BeginLink
   End If
End Function

Public Sub ClearAll()
   Dim x
   ' Xoa tat ca tên cac table trong BrokenLinkTbls Col.
   For Each x In BrokenLinkTbls
      BrokenLinkTbls.Remove (x)
   Next
End Sub

Public Function Relinktables(strFileName As String)

   Dim dbbackend As DAO.Database, dblocal As DAO.Database, ws As Workspace, x, y
   Dim tdlocal As DAO.TableDef
   
   On Error GoTo Err_Relink
   
   Set dbbackend = DBEngine(0).OpenDatabase(strFileName)
   Set dblocal = CurrentDb
   
   ' Neu tim thay table o file Front-end trung voi fiel du lieu back-end
   ' Se tao lai ket noi
   ' Xoa ten table khoi danh sach BrokenLinkTbls col.
    For Each x In BrokenLinkTbls
       If Len(dblocal.TableDefs(x).Connect) > 0 Then
           For Each y In dbbackend.TableDefs
               If y.Name = x Then
                   Set tdlocal = dblocal.TableDefs(x)
                   tdlocal.Connect = ";DATABASE=" & strPath
                   tdlocal.RefreshLink
                   BrokenLinkTbls.Remove (x)
               End If
           Next
       End If
   Next

Exit_Relink:
   Exit Function

Err_Relink:
   If Err.Number = 3043 Then
     MsgBox "Can not find the Master on the Network.  Check that you have a good network connection."
     Resume Exit_Relink
   Else
    'Call ErrHandler(Err.Number, Err.Description, "Error in Relinktables")
    Resume Exit_Relink
   End If
End Function

Public Sub CheckifComplete()

   Dim strTest As String, y As String, notfound As String, x
   On Error GoTo Err_BeginLink
   
   ' Kiem tra neu van con ten table trong danh sach BrokenLinkTbls la do không co table do o file Back-end.
   If BrokenLinkTbls.Count > 0 Then
       For Each x In BrokenLinkTbls
           notfound = notfound & x & Chr(13)
       Next
       ' Danh sach cac table chua ket noi duoc voi file du lieu back-end.
       y = MsgBoxUni("Các Table sau " & ChrW(273) & "ây không tìm th" & ChrW(7845) & "y trên file d" & ChrW(432) & " li" & ChrW(7879) & "u: " & _
       Chr(13) & Chr(13) & strPath _
       & ":" & Chr(13) & Chr(13) & notfound & Chr(13) & _
       "B" & ChrW(7841) & "n có ch" & ChrW(7885) & "n l" & ChrW(7841) & "i file d" & ChrW(7919) & " li" & ChrW(7879) & "u khác có ch" & ChrW(7913) & "a các tables này không?", _
       vbQuestion + vbYesNo, "Không tìm th" & ChrW(7845) & "y Table.")
       
       If y = vbNo Then
           Exit Sub
       End If
       'Mo file lay duong dan toi file du lieu moi
       strPath = fGetFileName()
       strTest = strPath
       If Len(strTest) = 0 Then   ' File not found.
           MsgBoxUni "Không tìm th" & ChrW(7845) & "y file d" & ChrW(7919) & " li" & ChrW(7879) & "u (.mdb, .accdb)." & vbCrLf & _
                 "Hãy th" & ChrW(7917) & " k" & ChrW(7871) & "t n" & ChrW(7889) & "i l" & ChrW(7841) & "i.", vbExclamation, "K" & ChrW(7871) & "t n" & ChrW(7889) & "i t" & ChrW(7899) & "i file d" & ChrW(7919) & " li" & ChrW(7879) & "u"
           Exit Sub
      End If
   
      Relinktables (strTest)
   Else
      Exit Sub
   End If
   
   CheckifComplete
   
Exit_BeginLink:
   DoCmd.Echo True   ' Just in case of error jump.
   DoCmd.Hourglass False
   Exit Sub

Err_BeginLink:
   Debug.Print Err.Number
   If Err.Number = 457 Then
       ClearAll
       Resume Next
   End If
   MsgBox Err.Number & ": " & Err.Description
   Resume Exit_BeginLink

End Sub

Public Function fGetFileName()
   Dim dlgopen As Object  'FileDialog'
   Dim strFolder As String
   Set dlgopen = Application.FileDialog(3)  '(msoFileDialogFolderPicker)'
   strFolder = "Chua ch?n folder nào c?"
   With dlgopen
       If .Show = -1 Then
           strFolder = dlgopen.SelectedItems(1)
           fGetFileName = strFolder
       End If
   End With
[font=Tahoma]End Function 


- Ở Form khởi động (ví dụ là form Splash), ở sự kiện OnLoad sẽ chạy cái Sub "CheckLinkedTables". Code của nó:

Mã PHP:

Option Explicit
[/font]

Dim errNo As Byte
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Sub CheckLinkedTables()

'Kiem tra cac Linked table voi cac file Databases

   Dim db As DAO.Database
   Dim strTest As String
   Dim td As DAO.TableDef

   On Error GoTo ErrHandler

   'DoCmd.Minimize  'An form Splash, cho chay ngam
   'Me.Visible = False
   
   Me.lblCheckingText.Visible = True: Me.lblResult.Visible = False:: Me.lblLostConn.Visible = False

   Set db = CurrentDb
   Dim lngRtn As Long
   Dim bShowSys As Boolean
   For Each td In db.TableDefs
       If Left(td.Name, 4) = "MSys" And bShowSys = False Then GoTo Continue  'Bo qua cac table he thong
       If Len(td.Connect) > 0 Then   'Kiem tra co phai linked table khong.
           On Error Resume Next   'Bo qua loi.
           strTest = Dir(Mid(td.Connect, 11))   'Lay ten database. Vd: db2.mdb
           'On Error GoTo ErrHandler   'Bo qua loi.
           If Len(strTest) = 0 Then   'Khong tim thay file database linked voi table.
               lngRtn = MsgBoxUni("Không tìm th" & ChrW(7845) & "y file d" & ChrW(7919) & " li" & ChrW(7879) & "u ngu" & ChrW(7891) & "n (data back end)." & vbCrLf & Mid(td.Connect, 11) & "." & vbCrLf & vbCrLf & _
                                  "Có th" & ChrW(7875) & " b" & ChrW(7883) & " xóa/ " & ChrW(273) & ChrW(7893) & "i tên ho" & ChrW(7863) & "c di chuy" & ChrW(7875) & "n qua folder khác." & vbCrLf & _
                                  "Hãy ch" & ChrW(7885) & "n file d" & ChrW(7919) & " li" & ChrW(7879) & "u d" & ChrW(7921) & " phòng cho các Table này.", vbExclamation + vbOKCancel + vbDefaultButton1, "Không tìm th" & ChrW(7845) & "y file d" & ChrW(7919) & " li" & ChrW(7879) & "u back-end.")
               If lngRtn = vbOK Then
                   strPath = fGetFileName()     'Mo FileDialog de tim file du lieu
                   If Len(strPath) > 0 Then  'Da chon duoc file du lieu (Database)
                       Call ProcessTables
                   Else
                       MsgBoxUni "B" & ChrW(7841) & "n không ch" & ChrW(7885) & "n file d" & ChrW(7919) & " li" & ChrW(7879) & "u Back-end nào. S" & ChrW(7869) & " thoát " & ChrW(7913) & "ng d" & ChrW(7909) & "ng.", vbExclamation, "Ph" & ChrW(7843) & "i ch" & ChrW(7885) & "n d" & ChrW(7919) & " li" & ChrW(7879) & "u Back-end."
                       DoCmd.Quit
                   End If
                   DoCmd.Close acForm, Me.Name  'Dong form Splash, mo form Login
                   DoCmd.OpenForm "frmLogin"
                   Exit Sub
               Else
                   MsgBoxUni "Không tìm th" & ChrW(7845) & "y file ngu" & ChrW(7891) & "n cho các linked table." & vbCrLf & _
                             "Hay ki" & ChrW(7875) & "m tra l" & ChrW(7841) & "i network ho" & ChrW(7863) & "c kh" & ChrW(7903) & "i " & ChrW(273) & ChrW(7897) & "ng l" & ChrW(7841) & "i " & ChrW(7913) & "ng d" & ChrW(7909) & "ng.", vbInformation, "Thông báo"
                   Exit Sub
               End If
           End If

           '----------------------------------------------------------------------------------------------
           'Check xem link có hoat dong không.
           DoEvents
           db.TableDefs(td.Name).RefreshLink
           Select Case Err.Number
           Case 0   'Phai them truong hop nay de tranh pop up error 0
               'Khong phat sinh loi
           Case 3265
               MsgBoxUni "Không tìm th" & ChrW(7845) & "y Table " & "[" & td.Name & "]" & vbCrLf & ChrW(7912) & "ng d" & ChrW(7909) & "ng s" & ChrW(7869) & " t" & ChrW(7921) & " " & ChrW(273) & ChrW(7897) & "ng " & ChrW(273) & "óng.", vbCritical, "Table Missing"
               DoCmd.Quit
           Case 3011, 3024     'Linked Table không ton tai hoac file mdb sai
               MsgBoxUni "Không tìm th" & ChrW(7845) & "y Table " & "[" & td.Name & "]" & ChrW(7903) & " file d" & ChrW(7919) & " li" & ChrW(7879) & "u back-end." & vbCrLf & _
                         "Hãy ki" & ChrW(7875) & "m tra tên Table có b" & ChrW(7883) & " thay " & ChrW(273) & ChrW(7893) & "i ho" & ChrW(7863) & "c network." & vbCrLf, vbCritical, ChrW(272) & ChrW(432) & ChrW(7901) & "ng link file không h" & ChrW(7907) & "p l" & ChrW(7879) & "."
               Me.TimerInterval = 2000
               errNo = 0
               Exit Sub
           Case Else
               MsgBox Err.Description & Err.Number, vbExclamation, "Linked table error"
           End Select

           '----------------------------------------------------------------------------------------------

       End If
Continue:
   Next
   Me.TimerInterval = 2000
   errNo = 1

Exit_ErrHandler:
   Exit Sub
ErrHandler:
   MsgBox Err.Number & ": " & Err.Description
   Resume Exit_ErrHandler
End Sub

Private Sub Form_Load()
   CheckLinkedTables
End Sub

Private Sub Form_Timer()
   Select Case errNo
   Case 0
       Me.lblCheckingText.Visible = False: Me.lblResult.Visible = False: Me.lblLostConn.Visible = True
       'Sleep 2000
       DoCmd.Close acForm, Me.Name
       DoCmd.Quit
   Case 1
       Me.lblCheckingText.Visible = False: Me.lblResult.Visible = True:: Me.lblLostConn.Visible = False
       Me.TimerInterval = 0
       'Sleep 1000
       DoCmd.Close acForm, Me.Name
       
       DoCmd.OpenForm "frmLogin"
   End Select
[font=Tahoma]End Sub 


(13-05-17, 01:17 AM)ongke0711 Đã viết: Gửi anh một cách tiếp cận khác cho việc cập nhật lại Linked Tables. Không bị xóa mất Table. Hy vọng đáp ứng đúng nhu cầu của anh.

Link file demo:http://www.mediafire.com/file/j666qh46ul...Tables.rar

Kịch bản nó như sau:
-
- Khi ứng dụng khởi động sẽ chạy 1 form khởi động (Splash form). Form nay sẽ check các tất cả các linked table (đường dẫn) có còn sống không (chỉ kiểm tra table nào link thôi)? Nếu có vấn đề sẽ tự động link lại. Sau đó sẽ đóng form Splash và gọi form Login.
- Thứ nhất nó sẽ kiểm tra xem có tìm thấy file database (.mdb) có còn ở đúng vị trí như trong dường dẫn hay không? (Có thể bị đổi tên). Nếu bị đổi tên hoặc đổi vị trí thì sẽ hiện hộp thoại để chọn lại đường dẫn. Sau đó sẽ Relink lại.
- Thứ hai nó sẽ kiểm tra các table có còn kết nối với file back-end không? Nếu không cũng sẽ relink lại. Nếu phát sinh trường hợp không có tên table nào đó trong file BE, nõ sẽ hiện thông báo tên table nào bị mất để tự sửa chửa rồi đóng ứng dụng lại.
- Không bị mất table như code bác Dân.
Do vậy anh có thể tự thử nghiệm các trường hợp như sau:
- Đổi tên file .mdb back-end.
- Đổi tên table trong file BE.
- Tạo các thêm các table, xóa table ở file BE để test.

Module Code cho việc này:
- Tạo 1 Standard module đặt tên là basCheckLinkedTables, copy đoạn code dưới đây vào.

Mã PHP:

Option Explicit
[/font]

Dim BrokenLinkTbls As New Collection
Public strPath As String

Public Sub AppendTables()
 On Error GoTo errLbl:
   Dim db As DAO.Database, x As Variant
   Dim strTest As String
   ' Them ten cac Table bi loi ket noi vao BrokenLinkTbls Collection.
   Set db = CurrentDb
   ClearAll
   For Each x In db.TableDefs
       If Len(x.Connect) > 1 And Len(Dir(Mid(x.Connect, 11))) = 0 Then
       'Co chuoi ket noi nhung khong co file mdb
            BrokenLinkTbls.Add Item:=x.Name, Key:=x.Name
       End If
   Next
   Exit Sub
errLbl:
  If Err.Number = 52 Then
  MsgBoxUni "Không có k" & ChrW(7871) & "t n" & ChrW(7889) & "i trong Network."
  For Each x In db.TableDefs
       If Len(x.Connect) > 1 Then
       'MsgBox x.Name & " " & x.Connect
       ' connect string exists, but file does not
        BrokenLinkTbls.Add Item:=x.Name, Key:=x.Name
       End If
   Next
  Else
    'Call ErrHandler(Err.Number, Err.Description, "Error in Appendtables")
  End If
End Sub

Public Function ProcessTables()

   Dim strTest As String
   On Error GoTo Err_BeginLink

   'Them vao BrokenLinkTbls cac tables bi loi ket noi
   AppendTables

   'Kiem tra duong dan ket noi
   strTest = strPath

   On Error GoTo Err_BeginLink
   If Len(strTest) = 0 Then   'Không tìm thay file hoac ban không chon file mdb nao.
       MsgBoxUni "Không tìm th" & ChrW(7845) & "y file d" & ChrW(7919) & " li" & ChrW(7879) & "u (.mdb, .accdb)." & vbCrLf & _
                 "Hãy th" & ChrW(7917) & " k" & ChrW(7871) & "t n" & ChrW(7889) & "i l" & ChrW(7841) & "i.", vbExclamation, "K" & ChrW(7871) & "t n" & ChrW(7889) & "i t" & ChrW(7899) & "i file d" & ChrW(7919) & " li" & ChrW(7879) & "u"
       Exit Function
   End If

   ' Bat dau Relink lai cac Tables
   Relinktables (strTest)
   ' Kiem tra lan nua các table da link chua.
   CheckifComplete

   DoCmd.Echo True, "Done"
   If BrokenLinkTbls.Count < 1 Then
       MsgBoxUni "Link t" & ChrW(7899) & "i file d" & ChrW(7919) & " li" & ChrW(7879) & "u Back-end thành công."
   Else
       MsgBoxUni "Còn table ch" & ChrW(432) & "a k" & ChrW(7871) & "t n" & ChrW(7889) & "i thành công v" & ChrW(7899) & "i file d" & ChrW(7919) & " li" & ChrW(7879) & "u Back-end."
   End If


Exit_BeginLink:
   DoCmd.Echo True
   Exit Function

Err_BeginLink:
   Debug.Print Err.Number
   If Err.Number = 457 Then
       ClearAll
       Resume Next
   ElseIf Err.Number = 3043 Then
       MsgBox "Can not find the Master on the Network.  Check that you have a good network connection."
       Resume Exit_BeginLink
   Else
       'Call ErrHandler(Err.Number, Err.Description, "Error in Processtables")
       Resume Exit_BeginLink
   End If
End Function

Public Sub ClearAll()
   Dim x
   ' Xoa tat ca tên cac table trong BrokenLinkTbls Col.
   For Each x In BrokenLinkTbls
      BrokenLinkTbls.Remove (x)
   Next
End Sub

Public Function Relinktables(strFileName As String)

   Dim dbbackend As DAO.Database, dblocal As DAO.Database, ws As Workspace, x, y
   Dim tdlocal As DAO.TableDef
   
   On Error GoTo Err_Relink
   
   Set dbbackend = DBEngine(0).OpenDatabase(strFileName)
   Set dblocal = CurrentDb
   
   ' Neu tim thay table o file Front-end trung voi fiel du lieu back-end
   ' Se tao lai ket noi
   ' Xoa ten table khoi danh sach BrokenLinkTbls col.
    For Each x In BrokenLinkTbls
       If Len(dblocal.TableDefs(x).Connect) > 0 Then
           For Each y In dbbackend.TableDefs
               If y.Name = x Then
                   Set tdlocal = dblocal.TableDefs(x)
                   tdlocal.Connect = ";DATABASE=" & strPath
                   tdlocal.RefreshLink
                   BrokenLinkTbls.Remove (x)
               End If
           Next
       End If
   Next

Exit_Relink:
   Exit Function

Err_Relink:
   If Err.Number = 3043 Then
     MsgBox "Can not find the Master on the Network.  Check that you have a good network connection."
     Resume Exit_Relink
   Else
    'Call ErrHandler(Err.Number, Err.Description, "Error in Relinktables")
    Resume Exit_Relink
   End If
End Function

Public Sub CheckifComplete()

   Dim strTest As String, y As String, notfound As String, x
   On Error GoTo Err_BeginLink
   
   ' Kiem tra neu van con ten table trong danh sach BrokenLinkTbls la do không co table do o file Back-end.
   If BrokenLinkTbls.Count > 0 Then
       For Each x In BrokenLinkTbls
           notfound = notfound & x & Chr(13)
       Next
       ' Danh sach cac table chua ket noi duoc voi file du lieu back-end.
       y = MsgBoxUni("Các Table sau " & ChrW(273) & "ây không tìm th" & ChrW(7845) & "y trên file d" & ChrW(432) & " li" & ChrW(7879) & "u: " & _
       Chr(13) & Chr(13) & strPath _
       & ":" & Chr(13) & Chr(13) & notfound & Chr(13) & _
       "B" & ChrW(7841) & "n có ch" & ChrW(7885) & "n l" & ChrW(7841) & "i file d" & ChrW(7919) & " li" & ChrW(7879) & "u khác có ch" & ChrW(7913) & "a các tables này không?", _
       vbQuestion + vbYesNo, "Không tìm th" & ChrW(7845) & "y Table.")
       
       If y = vbNo Then
           Exit Sub
       End If
       'Mo file lay duong dan toi file du lieu moi
       strPath = fGetFileName()
       strTest = strPath
       If Len(strTest) = 0 Then   ' File not found.
           MsgBoxUni "Không tìm th" & ChrW(7845) & "y file d" & ChrW(7919) & " li" & ChrW(7879) & "u (.mdb, .accdb)." & vbCrLf & _
                 "Hãy th" & ChrW(7917) & " k" & ChrW(7871) & "t n" & ChrW(7889) & "i l" & ChrW(7841) & "i.", vbExclamation, "K" & ChrW(7871) & "t n" & ChrW(7889) & "i t" & ChrW(7899) & "i file d" & ChrW(7919) & " li" & ChrW(7879) & "u"
           Exit Sub
      End If
   
      Relinktables (strTest)
   Else
      Exit Sub
   End If
   
   CheckifComplete
   
Exit_BeginLink:
   DoCmd.Echo True   ' Just in case of error jump.
   DoCmd.Hourglass False
   Exit Sub

Err_BeginLink:
   Debug.Print Err.Number
   If Err.Number = 457 Then
       ClearAll
       Resume Next
   End If
   MsgBox Err.Number & ": " & Err.Description
   Resume Exit_BeginLink

End Sub

Public Function fGetFileName()
   Dim dlgopen As Object  'FileDialog'
   Dim strFolder As String
   Set dlgopen = Application.FileDialog(3)  '(msoFileDialogFolderPicker)'
   strFolder = "Chua ch?n folder nào c?"
   With dlgopen
       If .Show = -1 Then
           strFolder = dlgopen.SelectedItems(1)
           fGetFileName = strFolder
       End If
   End With
[font=Tahoma]End Function 


- Ở Form khởi động (ví dụ là form Splash), ở sự kiện OnLoad sẽ chạy cái Sub "CheckLinkedTables". Code của nó:

Mã PHP:

Option Explicit
[/font]

Dim errNo As Byte
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Sub CheckLinkedTables()

'Kiem tra cac Linked table voi cac file Databases

   Dim db As DAO.Database
   Dim strTest As String
   Dim td As DAO.TableDef

   On Error GoTo ErrHandler

   'DoCmd.Minimize  'An form Splash, cho chay ngam
   'Me.Visible = False
   
   Me.lblCheckingText.Visible = True: Me.lblResult.Visible = False:: Me.lblLostConn.Visible = False

   Set db = CurrentDb
   Dim lngRtn As Long
   Dim bShowSys As Boolean
   For Each td In db.TableDefs
       If Left(td.Name, 4) = "MSys" And bShowSys = False Then GoTo Continue  'Bo qua cac table he thong
       If Len(td.Connect) > 0 Then   'Kiem tra co phai linked table khong.
           On Error Resume Next   'Bo qua loi.
           strTest = Dir(Mid(td.Connect, 11))   'Lay ten database. Vd: db2.mdb
           'On Error GoTo ErrHandler   'Bo qua loi.
           If Len(strTest) = 0 Then   'Khong tim thay file database linked voi table.
               lngRtn = MsgBoxUni("Không tìm th" & ChrW(7845) & "y file d" & ChrW(7919) & " li" & ChrW(7879) & "u ngu" & ChrW(7891) & "n (data back end)." & vbCrLf & Mid(td.Connect, 11) & "." & vbCrLf & vbCrLf & _
                                  "Có th" & ChrW(7875) & " b" & ChrW(7883) & " xóa/ " & ChrW(273) & ChrW(7893) & "i tên ho" & ChrW(7863) & "c di chuy" & ChrW(7875) & "n qua folder khác." & vbCrLf & _
                                  "Hãy ch" & ChrW(7885) & "n file d" & ChrW(7919) & " li" & ChrW(7879) & "u d" & ChrW(7921) & " phòng cho các Table này.", vbExclamation + vbOKCancel + vbDefaultButton1, "Không tìm th" & ChrW(7845) & "y file d" & ChrW(7919) & " li" & ChrW(7879) & "u back-end.")
               If lngRtn = vbOK Then
                   strPath = fGetFileName()     'Mo FileDialog de tim file du lieu
                   If Len(strPath) > 0 Then  'Da chon duoc file du lieu (Database)
                       Call ProcessTables
                   Else
                       MsgBoxUni "B" & ChrW(7841) & "n không ch" & ChrW(7885) & "n file d" & ChrW(7919) & " li" & ChrW(7879) & "u Back-end nào. S" & ChrW(7869) & " thoát " & ChrW(7913) & "ng d" & ChrW(7909) & "ng.", vbExclamation, "Ph" & ChrW(7843) & "i ch" & ChrW(7885) & "n d" & ChrW(7919) & " li" & ChrW(7879) & "u Back-end."
                       DoCmd.Quit
                   End If
                   DoCmd.Close acForm, Me.Name  'Dong form Splash, mo form Login
                   DoCmd.OpenForm "frmLogin"
                   Exit Sub
               Else
                   MsgBoxUni "Không tìm th" & ChrW(7845) & "y file ngu" & ChrW(7891) & "n cho các linked table." & vbCrLf & _
                             "Hay ki" & ChrW(7875) & "m tra l" & ChrW(7841) & "i network ho" & ChrW(7863) & "c kh" & ChrW(7903) & "i " & ChrW(273) & ChrW(7897) & "ng l" & ChrW(7841) & "i " & ChrW(7913) & "ng d" & ChrW(7909) & "ng.", vbInformation, "Thông báo"
                   Exit Sub
               End If
           End If

           '----------------------------------------------------------------------------------------------
           'Check xem link có hoat dong không.
           DoEvents
           db.TableDefs(td.Name).RefreshLink
           Select Case Err.Number
           Case 0   'Phai them truong hop nay de tranh pop up error 0
               'Khong phat sinh loi
           Case 3265
               MsgBoxUni "Không tìm th" & ChrW(7845) & "y Table " & "[" & td.Name & "]" & vbCrLf & ChrW(7912) & "ng d" & ChrW(7909) & "ng s" & ChrW(7869) & " t" & ChrW(7921) & " " & ChrW(273) & ChrW(7897) & "ng " & ChrW(273) & "óng.", vbCritical, "Table Missing"
               DoCmd.Quit
           Case 3011, 3024     'Linked Table không ton tai hoac file mdb sai
               MsgBoxUni "Không tìm th" & ChrW(7845) & "y Table " & "[" & td.Name & "]" & ChrW(7903) & " file d" & ChrW(7919) & " li" & ChrW(7879) & "u back-end." & vbCrLf & _
                         "Hãy ki" & ChrW(7875) & "m tra tên Table có b" & ChrW(7883) & " thay " & ChrW(273) & ChrW(7893) & "i ho" & ChrW(7863) & "c network." & vbCrLf, vbCritical, ChrW(272) & ChrW(432) & ChrW(7901) & "ng link file không h" & ChrW(7907) & "p l" & ChrW(7879) & "."
               Me.TimerInterval = 2000
               errNo = 0
               Exit Sub
           Case Else
               MsgBox Err.Description & Err.Number, vbExclamation, "Linked table error"
           End Select

           '----------------------------------------------------------------------------------------------

       End If
Continue:
   Next
   Me.TimerInterval = 2000
   errNo = 1

Exit_ErrHandler:
   Exit Sub
ErrHandler:
   MsgBox Err.Number & ": " & Err.Description
   Resume Exit_ErrHandler
End Sub

Private Sub Form_Load()
   CheckLinkedTables
End Sub

Private Sub Form_Timer()
   Select Case errNo
   Case 0
       Me.lblCheckingText.Visible = False: Me.lblResult.Visible = False: Me.lblLostConn.Visible = True
       'Sleep 2000
       DoCmd.Close acForm, Me.Name
       DoCmd.Quit
   Case 1
       Me.lblCheckingText.Visible = False: Me.lblResult.Visible = True:: Me.lblLostConn.Visible = False
       Me.TimerInterval = 0
       'Sleep 1000
       DoCmd.Close acForm, Me.Name
       
       DoCmd.OpenForm "frmLogin"
   End Select
[font=Tahoma]End Sub 


Quá tuyệt vời luôn Ongke à 

Ongke ơi còn cái này nữa muốn Ongke giúp : Tức là khi kết nối vào File không đủ điều kiện thì nó sẽ lên câu hỏi để mở tiếp. Tuy nhiên nếu File mở đã đủ điều kiện, đã kết nối thì : 
Muốn mở một file dữ liệu khác thì làm thể nào ?
Ví dụ : Anh có 3 dữ liệu của 3 công ty khác nhau (CTA, CTB,CTC), cùng có chung kiểu bảng như nhau. Khi đã kết nối với CTA, thì lúc muốn kết nối (mở) CTB hoặc CTC thì làm thế nào ?
Ongke giúp anh với nhé, anh cảm ơn nhiều.

(13-05-17, 03:01 PM)ledangvan Đã viết: Muốn mở một file dữ liệu khác thì làm thể nào ?
Ví dụ : Anh có 3 dữ liệu của 3 công ty khác nhau (CTA, CTB,CTC), cùng có chung kiểu bảng như nhau. Khi đã kết nối với CTA, thì lúc muốn kết nối (mở) CTB hoặc CTC thì làm thế nào ?

Ý anh là: Ví dụ mọi kết nối các bảng đều Ok cả rồi nhưng bây giờ muốn có thêm tùy chọn là chọn kết nối với nguồn dữ liệu nào cần để báo cáo phải không? Giống như 1 Cty có nhiều chi nhánh, khi cần báo cáo chi nhánh nào thì kết nối với nguồn dữ liệu của chi nhánh đó. Các table dều giống nhau hết.

ĐÚng đấy Ongke, có nhiều công ty dùng chung một phần mềm khi đang ở Công ty A thì xem được dữ liệu công ty A, nhưng khi muốn xem dữ liệu của công ty B thì thường sẽ ấn vào nút mở dữ liệu để mở dữ liệu của Công ty B hoặc ...

Thực ra không cần làm thêm cái menu chọn nguồn dữ liệu (CtyA, CtyB...) thì đối với cái frmSplash trong demo cũng đã có thể tùy chọn nguồn dữ liệu BE được rồi. 
Ví dụ: khi anh đem cái ứng dụng cài cho cty khác thì chỉ cần đổi tên file .mdb back-end thì khi ứng dụng chạy nó sẽ thông báo cập nhật ngay.
Còn nếu anh vẫn muốn thêm cái menu tùy chọn nguồn dữ liệu thì thiết kế thêm chút nữa. Cái tùy chọn này cũng sẽ có 2 trường hợp:
  1. Khi ứng dụng đã kết nối nguồn dữ liệu hiện tại và đang chạy tốt và anh muốn chọn nguồn dữ liệu khác thì cái nút lệnh này sẽ nằm trong 1 cái form quản trị hệ thống nào đó của ứng dụng.
  2. Khi khởi động ứng dụng là xuất hiện form Login trong form này sẽ có tùy chọn kết nối nguồn dữ liệu nào trước khi đăng nhập.
Nếu làm thêm nút lệnh thì cần thời gian để em ngâm cứu code thêm cho nó vì cũng chưa làm vụ này.
Em nghĩ ứng dụng của anh dùng bộ thư viện DAO để lập trình thì việc đổi Database cũng dễ. Nó nằm ở câu lệnh: 
     Set db = OpenDatabase ("Tên Database")
Các anh em khác đã thiết kế qua vụ này rồi thì chia sẽ cách làm giùm luôn nhé. 
Cám ơn.

(13-05-17, 05:12 PM)ongke0711 Đã viết: Thực ra không cần làm thêm cái menu chọn nguồn dữ liệu (CtyA, CtyB...) thì đối với cái frmSplash trong demo cũng đã có thể tùy chọn nguồn dữ liệu BE được rồi. 
Ví dụ: khi anh đem cái ứng dụng cài cho cty khác thì chỉ cần đổi tên file .mdb back-end thì khi ứng dụng chạy nó sẽ thông báo cập nhật ngay.
Còn nếu anh vẫn muốn thêm cái menu tùy chọn nguồn dữ liệu thì thiết kế thêm chút nữa. Cái tùy chọn này cũng sẽ có 2 trường hợp:
  1. Khi ứng dụng đã kết nối nguồn dữ liệu hiện tại và đang chạy tốt và anh muốn chọn nguồn dữ liệu khác thì cái nút lệnh này sẽ nằm trong 1 cái form quản trị hệ thống nào đó của ứng dụng.
  2. Khi khởi động ứng dụng là xuất hiện form Login trong form này sẽ có tùy chọn kết nối nguồn dữ liệu nào trước khi đăng nhập.
Nếu làm thêm nút lệnh thì cần thời gian để em ngâm cứu code thêm cho nó vì cũng chưa làm vụ này.
Em nghĩ ứng dụng của anh dùng bộ thư viện DAO để lập trình thì việc đổi Database cũng dễ. Nó nằm ở câu lệnh: 
     Set db = OpenDatabase ("Tên Database")
Các anh em khác đã thiết kế qua vụ này rồi thì chia sẽ cách làm giùm luôn nhé. 
Cám ơn.

Ongke ơi thực ra cách mà anh hỏi, thì anh đã có thực hiện được theo cách có activex Control tuy nhiên anh không muốn dùng vì nó hay bị lỗi khi sử dụng Win64 bit hoặc một số bản Office.
Cách mà anh dùng activex Control đây : http://www.mediafire.com/file/s4uwih26j9...Ketnoi.rar

(13-05-17, 05:12 PM)ongke0711 Đã viết: ....
Các anh em khác đã thiết kế qua vụ này rồi thì chia sẽ cách làm giùm luôn nhé. 
Cám ơn.

1-Bác thêm một biến VD: Public blnChangeDB As Boolean

2-Sửa thủ tục AppendTables lại một chút:

3-Code cho nút thay đổi nguồn dữ liệu như sau:

File đã thêm

Nút  thay đổi nguồn dữ liệu nằm ở form1 (chưa đọc hết code trong file nên test kỹ trước khi sử dụng nha  )

(14-05-17, 11:01 PM)ledangvan Đã viết: ...
Ongke ơi thực ra cách mà anh hỏi, thì anh đã có thực hiện được theo cách có activex Control tuy nhiên anh không muốn dùng vì nó hay bị lỗi khi sử dụng Win64 bit hoặc một số bản Office.
Cách mà anh dùng activex Control đây : http://www.mediafire.com/file/s4uwih26j9...Ketnoi.rar
...

Cách anh đang dùng là dùng phương thức RefreshLink truyền thống và nó không khắc phục được mấy cái lỗi như tên table bị thay đổi, bị xóa...

Xử lý như cách của bác MTNQ ok rồi đó anh. Anh test xem.