module liên kết dữ liệu từ xa
Public Function Dlinks(tentable As String) As Boolean
Dim vAppPath As String, vBackEndPath As String, filedb As String
Dim dbLocal As Database
Dim tdf As TableDef
Dim vCount As Long
On Error GoTo ErrorCode 'trap errors including No Linked Table Found (see below)
'Check if DatabaseName.ini file exists and if not then create a new one
Set dbLocal = CurrentDb()
vAppPath = dbLocal.Name 'fetch filename of front-end file
vAppPath = Left(vAppPath, Len(vAppPath) - 3) 'replace ...mdb (assumes extension is .mdb or .mde)
vAppPath = vAppPath & "ini" 'with ...ini
If Dir(vAppPath) = "" Then 'if .ini file not present on disk then
filedb = Txtpath 'show file selector and choose back-end file
Dlinks = False 'return False if user cancels File Selector dialog
If filedb = "" Then Exit Function 'abort if user cancels File Selector (Dlinks = False)
Open vAppPath For Binary As #1 'create new .ini file (use same filename as front end)
Put #1, , filedb 'write new .ini file to disk with pathname of back end
Close #1 'close file
End If
'Fetch full path and filename of back end file from .ini file
Open vAppPath For Binary As #1 'open .ini file
filedb = String(LOF(1), "*") 'fill filedb with * first
Get #1, , filedb 'read .ini file from disk into filedb
Close #1 'and close file
'Copy pathname and filename of back end file into vBackEndPath (using an existing table)
vBackEndPath = CurrentDb.TableDefs(tentable).Connect 'fetch connection string for specified table
vBackEndPath = Right(vBackEndPath, Len(vBackEndPath) - 10) 'and remove prefix string (;DATABASE=)
'If back end location stored in front end <> back end location from the .ini file then relink tables
If filedb <> vBackEndPath Then 'if back end file location not the same then
DoCmd.Hourglass True
vCount = dbLocal.TableDefs.Count 'fetch No of tables to relink
Call SysCmd(acSysCmdInitMeter, "Relinking Tables to File " & filedb, vCount)
vCount = 0 'set table counter to 0
For Each tdf In dbLocal.TableDefs 'loop through all (non-system) tables
If Len(tdf.Connect) > 0 Then 'skip if system table
vCount = vCount + 1 'inc table counter
tdf.Connect = ";DATABASE=" & filedb 'set pathname + filename of back-end
tdf.RefreshLink 'and make link to back end (if error go to ErrorCode)
End If
Call SysCmd(acSysCmdUpdateMeter, vCount + 1) 'show progress bar
Next tdf 'repeat till all tables linked
DoCmd.Hourglass False
Call SysCmd(acSysCmdRemoveMeter) 'hide progress bar
End If
Dlinks = True 'return with no error (Dlinks = True)
dbLocal.Close 'close local database
Set dbLocal = Nothing
Exit Function 'exit (Dlinks = True)
ErrorCode:
If Err = 3011 Then Resume Next 'if Error 3011 then carry on (see separate Word documentation)
Call SysCmd(acSysCmdRemoveMeter) 'hide progress bar
DoCmd.Hourglass False
MsgBox Err & " " & Err.Description 'show error and then
Dlinks = False 'return False (and quit application) if serious error
End Function
vidu : bạn tạo 1 form với 1 textbox với name : txtpath ( đây là đường dẫn file data.mdb), 1 textbox với name : txttable( đây là tên table bất kỳ mà bạn biết trong file data.mdb), 1 button
Bạn cho mình với nhé. Thanks in advance.
