Tùy chọn
Mở kết nối lại link table không cần activex Control
- Mở kết nối lại link table không cần activex Control
-
RE: Mở kết nối lại link table không cần activex Control
ledangvan > 12-05-17, 10:27 PM
(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. -
RE: Mở kết nối lại link table không cần activex Control
ongke0711 > 13-05-17, 01:17 AM
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 -
RE: Mở kết nối lại link table không cần activex Control
ledangvan > 13-05-17, 09:04 AM
(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 à
-
RE: Mở kết nối lại link table không cần activex Control
ledangvan > 13-05-17, 03:01 PM
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. -
RE: Mở kết nối lại link table không cần activex Control
ongke0711 > 13-05-17, 04:13 PM
(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. -
RE: Mở kết nối lại link table không cần activex Control
ledangvan > 13-05-17, 04:49 PM
ĐÚ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 ... -
RE: Mở kết nối lại link table không cần activex Control
ongke0711 > 13-05-17, 05:12 PM
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. -
RE: Mở kết nối lại link table không cần activex Control
ledangvan > 14-05-17, 11:01 PM
(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 -
RE: Mở kết nối lại link table không cần activex Control
MTNQ > 15-05-17, 12:28 PM
(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:
Mã: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 Then
If blnChangeDB Then
BrokenLinkTbls.Add Item:=x.Name, Key:=x.Name
'Debug.Print x.Name
ElseIf 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
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
3-Code cho nút thay đổi nguồn dữ liệu như sau:
Mã:Private Sub Command0_Click()
blnChangeDB = True
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.", vbExclamation, "Ph" & ChrW(7843) & "i ch" & ChrW(7885) & "n d" & ChrW(7919) & " li" & ChrW(7879) & "u Back-end."
'DoCmd.Quit
End If
End Sub
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
)
-
RE: Mở kết nối lại link table không cần activex Control
ongke0711 > 15-05-17, 01:51 PM
(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.