modAttachTables
Đây là code cũ của mình từ cách đây hơn 10 năm rồi nên thời đó mình dùng DAO.
Copy and cut đoạn sau và lưu vào file có tên là modAttachTables.bas
(Muốn copy có cấu trúc thì dùng nút Quote trên diễn đàn nhé)
----------------------------------------------------------------------
Attribute VB_Name = "modAttachTables"
'Option Explicit
'----------------------------------------------------------------------
' GetAttachedDBPath
'
' Returns the path of the attached table's .MDB. If the attached
' table is not an Access table, or if the table specified by
' AttachedTableName is a local table, then this function will
' return an empty string ("").
'----------------------------------------------------------------------
Function GetAttachedDBPath(AttachedTableName) As String
On Error GoTo GetAttachedDBPath_Err
Const ATTACHED_TABLE_PREFIX = ";DATABASE="
Dim AttachedDBPath As String ' The attached path
Dim DBStrLength As Integer ' Length of the Connect string prefix
Dim db As Database ' Current Database
DBStrLength = Len(ATTACHED_TABLE_PREFIX)
' Retrieve the full connect string.
Set db = DBEngine.Workspaces(0).OpenDatabase(DataPath & DATA_ATTACH_FILE)
AttachedDBPath = db(AttachedTableName).Connect
' If this is a Connect string for an Access database, then
' strip out the path, otherwise return the empty string.
If (left$(AttachedDBPath, DBStrLength) = ATTACHED_TABLE_PREFIX) Then
AttachedDBPath = right$(AttachedDBPath, Len(AttachedDBPath) - DBStrLength)
Else
AttachedDBPath = ""
End If
GetAttachedDBPath_Exit:
GetAttachedDBPath = AttachedDBPath
Exit Function
GetAttachedDBPath_Err:
Screen.MousePointer = 0
ErrorMsg "GetAttachedDBPath", "modAttachTables", Err.Number, Err.Description
AttachedDBPath = ""
Resume GetAttachedDBPath_Exit
End Function
'----------------------------------------------------------------------
' AttachTables
'
' Attaches tables to the database specified in FileName.
' This function returns TRUE if successful.
'----------------------------------------------------------------------
Function AttachTables(FileName As String) As Integer
On Error GoTo AttachTables_Err
Dim db As Database
Dim td As TableDef
Dim i As Integer
Set db = DBEngine.Workspaces(0).OpenDatabase(DataPath & DATA_ATTACH_FILE)
' Initialize progress meter.
' Display the splash screen during intialization
DisplaySplash True
DoEvents 'ensures that the splash screen will get a chance to repaint
Screen.MousePointer = vbHourglass ' Wait
' Loop through all tables, reattaching those with nonzero-length
' Connect strings. Tables with zero-length Connect strings are
' local tables, not attached tables.
For i = 0 To db.TableDefs.Count - 1
Set td = db.TableDefs(i)
If db.TableDefs.Count - 1 = 0 Then
Percent% = 100
Else
Percent% = Int((i / (db.TableDefs.Count - 1)) * 100)
End If
' If this is an attached table, try to reattach it.
If td.Connect <> "" Then
td.Connect = ";DATABASE=" & FileName
On Error Resume Next
td.RefreshLink
On Error GoTo AttachTables_Err
If Err <> 0 Then
MsgBox "File '" & FileName & "' does not contain required table(s)'" & td.SourceTableName & "'", 16, "Incorrect Database"
AttachTables = False
GoTo AttachTables_Exit:
End If
End If
Progress Percent%, ""
Next i
AttachTables = True
AttachTables_Exit:
On Error Resume Next
DisplaySplash False
Screen.MousePointer = vbDefault
db.Close
Exit Function
AttachTables_Err:
Screen.MousePointer = vbDefault
ErrorMsg "AttachTables", "modAttachTables", Err.Number, Err.Description
AttachTables = False
Resume AttachTables_Exit
End Function
'----------------------------------------------------------------------
' AreTablesAttached
'
' Returns TRUE if valid attachments to the back-end database exist.
'----------------------------------------------------------------------
Function AreTablesAttached(sAttachTableName As String) As Integer
On Error GoTo AreTablesAttached_Err
Dim db As Database
Set db = DBEngine.Workspaces(0).OpenDatabase(DataPath & DATA_ATTACH_FILE)
' Ignoring errors, try to open a recordset
' on a table in the back-end database.
On Error Resume Next
' db.TableDefs(GetConfigItem(CONFIG_ID_ATTACHED_TABLE_NAME)).RefreshLink
db.TableDefs(sAttachTableName).RefreshLink
' If we hit an error (i.e. Err <> 0) then
' the tables were not attached.
AreTablesAttached = (Err = 0)
On Error GoTo AreTablesAttached_Err
' Clean up
db.Close
AreTablesAttached_Exit:
Exit Function
AreTablesAttached_Err:
ErrorMsg "AreTablesAttached", "modAttachTables", Err.Number, Err.Description
AreTablesAttached = False
Resume AreTablesAttached_Exit
End Function