• Tùy chọn
• Đăng nhập
• Đăng ký
• Xem như trên Máy tính
• Accelerated Mobile Pages Theme

Kết nối bảng từ access A đến access B

• Trang chủ

  • Thủ Thuật Access
  • Access Nâng Cao
  • Thủ thuật VBA
  • [Help] Kết nối bảng từ access A đến access B
• Kết nối bảng từ access A đến access B

• Kết nối bảng từ access A đến access B

  hieunx > 09-04-24, 01:08 PM

  Mình có thiết kế cơ sở dữ liệu cho 6 phường trên địa bàn của mình để theo dõi hồ sơ thu phí lệ phí. Mỗi phường 1 data riêng.
  Nay mình cần gom lại chung. Nhờ anh chị diên đàn giúp mình. Mình gửi demo nhờ anh chị xem giúp ạ.
  Mình có: App.accdb (chưa form, table thì link tới P1, hoặc P2, chưa table có tên và cấu trúc giống nhau).
  Trên App.accdb, mình có 1 form, gồm 2 nút lệnh. có thể giúp mình khi bấm nút Data1 thì mở form "hoSoThuPhi" và table thì link đến table ở P1.accdb, còn khi bấm Data2 thì  mở form "hoSoThuPhi" và table thì link đến table ở P2.accdb
  Mình mới tập tành về VBA nên mong các anh chị giúp đỡ.
  File đính kèm: https://drive.google.com/file/d/1o5Qf8bl...sp=sharing

• RE: Kết nối bảng từ access A đến access B

  ongke0711 > 09-04-24, 09:16 PM

  (09-04-24, 01:08 PM)hieunx Đã viết: Mình có thiết kế cơ sở dữ liệu cho 6 phường trên địa bàn của mình để theo dõi hồ sơ thu phí lệ phí. Mỗi phường 1 data riêng.
  Nay mình cần gom lại chung. Nhờ anh chị diên đàn giúp mình. Mình gửi demo nhờ anh chị xem giúp ạ.
  Mình có: App.accdb (chưa form, table thì link tới P1, hoặc P2, chưa table có tên và cấu trúc giống nhau).
  Trên App.accdb, mình có 1 form, gồm 2 nút lệnh. có thể giúp mình khi bấm nút Data1 thì mở form "hoSoThuPhi" và table thì link đến table ở P1.accdb, còn khi bấm Data2 thì  mở form "hoSoThuPhi" và table thì link đến table ở P2.accdb
  Mình mới tập tành về VBA nên mong các anh chị giúp đỡ.
  File đính kèm: https://drive.google.com/file/d/1o5Qf8bl...sp=sharing

  
  Bạn xem file đính kèm.
  Bạn nên chạy "Compact & Repair Database" trước khi gửi để database được nhẹ đi. Vào Menu File.
  
  Code:
  
  

  Mã PHP:

  Option Compare Database
Option Explicit

Private Sub cmdData1_Click()
    changeDatabase
End Sub

Private Sub cmdData2_Click()
    changeDatabase
End Sub

Sub changeDatabase()
    Me.txtDBPath = chonDatabase
    If Len(Nz(Me.txtDBPath, "")) > 1 Then
        relinkTables
    Else
        MsgBox "Ban chua chon database", vbCritical, "Thông báo"
    End If
End Sub


Function chonDatabase() As String
    Dim fDialog As Object 'Office.FileDialog

    Set fDialog = Application.FileDialog(3) '(msoFileDialogFilePicker)
    With fDialog
        .AllowMultiSelect = False  'Chi chon 1 file
        .Title = "Chon Database can lien ket"
        .Filters.Clear
        .Filters.Add "Database", "*.accdb"
        .Filters.Add "All Files", "*.*"
        
        If .Show = True Then    'True: Nguoi dung da chon file, False: nguoi dung bam Cancel
            chonDatabase = .SelectedItems(1)
        Else
            chonDatabase = ""
            MsgBox "Ban khong chon file nao."
        End If
    End With
    Set fDialog = Nothing
End Function

Sub relinkTables()
    Dim dbs As DAO.Database, tdf As DAO.TableDef
    Dim StrTable As String, linkDataBase As String

    On Error GoTo EH

    Set dbs = CurrentDb
    linkDataBase = Me.txtDBPath
    For Each tdf In CurrentDb.TableDefs
        If Len(tdf.Connect) > 1 Then 'chi relink linked tables
            If Left(tdf.Connect, 4) <> "ODBC" Or Left(tdf.Connect, 4) <> "MSys*" Then 'Khong relink ODBC hoac table he thong
                StrTable = tdf.Name
                dbs.TableDefs(StrTable).Connect = ";DATABASE=" & linkDataBase
                dbs.TableDefs(StrTable).RefreshLink
            End If
        End If
    Next
    MsgBox "Da link table thanh cong.", vbInformation, "Thông báo"
    
EH_Exit:
    Set dbs = Nothing
    Exit Sub
EH:
    MsgBox "Loi: " & Err.Number & vbCrLf & "No dung: " & Err.Description, vbCritical, "Relink Tables Error"
    Resume EH_Exit
    
End Sub 


  
  Link file: https://www.mediafire.com/file/gielj96nm...x.zip/file

• RE: Kết nối bảng từ access A đến access B

  hieunx > 10-04-24, 09:37 AM

  (09-04-24, 09:16 PM)ongke0711 Đã viết:

  (09-04-24, 01:08 PM)hieunx Đã viết: Mình có thiết kế cơ sở dữ liệu cho 6 phường trên địa bàn của mình để theo dõi hồ sơ thu phí lệ phí. Mỗi phường 1 data riêng.
  Nay mình cần gom lại chung. Nhờ anh chị diên đàn giúp mình. Mình gửi demo nhờ anh chị xem giúp ạ.
  Mình có: App.accdb (chưa form, table thì link tới P1, hoặc P2, chưa table có tên và cấu trúc giống nhau).
  Trên App.accdb, mình có 1 form, gồm 2 nút lệnh. có thể giúp mình khi bấm nút Data1 thì mở form "hoSoThuPhi" và table thì link đến table ở P1.accdb, còn khi bấm Data2 thì  mở form "hoSoThuPhi" và table thì link đến table ở P2.accdb
  Mình mới tập tành về VBA nên mong các anh chị giúp đỡ.
  File đính kèm: https://drive.google.com/file/d/1o5Qf8bl...sp=sharing

  
  Bạn xem file đính kèm.
  Bạn nên chạy "Compact & Repair Database" trước khi gửi để database được nhẹ đi. Vào Menu File.
  
  Code:
  
  

  Mã PHP:

  Option Compare Database
Option Explicit

Private Sub cmdData1_Click()
    changeDatabase
End Sub

Private Sub cmdData2_Click()
    changeDatabase
End Sub

Sub changeDatabase()
    Me.txtDBPath = chonDatabase
    If Len(Nz(Me.txtDBPath, "")) > 1 Then
        relinkTables
    Else
        MsgBox "Ban chua chon database", vbCritical, "Thông báo"
    End If
End Sub


Function chonDatabase() As String
    Dim fDialog As Object 'Office.FileDialog

    Set fDialog = Application.FileDialog(3) '(msoFileDialogFilePicker)
    With fDialog
        .AllowMultiSelect = False  'Chi chon 1 file
        .Title = "Chon Database can lien ket"
        .Filters.Clear
        .Filters.Add "Database", "*.accdb"
        .Filters.Add "All Files", "*.*"
        
        If .Show = True Then    'True: Nguoi dung da chon file, False: nguoi dung bam Cancel
            chonDatabase = .SelectedItems(1)
        Else
            chonDatabase = ""
            MsgBox "Ban khong chon file nao."
        End If
    End With
    Set fDialog = Nothing
End Function

Sub relinkTables()
    Dim dbs As DAO.Database, tdf As DAO.TableDef
    Dim StrTable As String, linkDataBase As String

    On Error GoTo EH

    Set dbs = CurrentDb
    linkDataBase = Me.txtDBPath
    For Each tdf In CurrentDb.TableDefs
        If Len(tdf.Connect) > 1 Then 'chi relink linked tables
            If Left(tdf.Connect, 4) <> "ODBC" Or Left(tdf.Connect, 4) <> "MSys*" Then 'Khong relink ODBC hoac table he thong
                StrTable = tdf.Name
                dbs.TableDefs(StrTable).Connect = ";DATABASE=" & linkDataBase
                dbs.TableDefs(StrTable).RefreshLink
            End If
        End If
    Next
    MsgBox "Da link table thanh cong.", vbInformation, "Thông báo"
    
EH_Exit:
    Set dbs = Nothing
    Exit Sub
EH:
    MsgBox "Loi: " & Err.Number & vbCrLf & "No dung: " & Err.Description, vbCritical, "Relink Tables Error"
    Resume EH_Exit
    
End Sub 


  
  Link file: https://www.mediafire.com/file/gielj96nm...x.zip/file

  Cảm ơn bạn rất nhiều. Mình sẽ lưu ý khi up file.
  Phần file demo mình xem lại cách bạn làm. Quá tuyệt với, sáng nay mình đã tiếp tục công việc và áp dụng phần code bạn đã hỗ trợ.
  Nên nếu được nhờ bạn giúp thêm 1 đoạn: khi bấm nút Data1 thì mở form "hoSoThuPhi" và table thì tự động link đến table ở P1.accdb (tương tự cho data2) mà không phải xuất hiện hộp thoại chọn data nữa. Kiểu add sẵn đường dẫn đến thư mực chứa data và tự động chọn data đã chỉ định.

• RE: Kết nối bảng từ access A đến access B

  ongke0711 > 10-04-24, 02:46 PM

  (10-04-24, 09:37 AM)hieunx Đã viết: Nên nếu được nhờ bạn giúp thêm 1 đoạn: khi bấm nút Data1 thì mở form "hoSoThuPhi" và table thì tự động link đến table ở P1.accdb (tương tự cho data2) mà không phải xuất hiện hộp thoại chọn data nữa. Kiểu add sẵn đường dẫn đến thư mực chứa data và tự động chọn data đã chỉ định.

  
  Cái này cũng đơn giản, thêm vài dòng code thôi.
  Tôi sửa lại theo hướng:
  - Sẽ tự động link với database nếu database đó nằm cùng folder với file App.accdb mà không cần chọn đường dẫn.
  - Nếu các database (P1, P2) bị thay đổi đường dẫn hoặc đổi tên thì nó sẽ hiện hộp thoại để chọn lại đường dẫn file.
  - Nếu database có đặt mật khẩu thì nhập MK và tự kết nối.
  
  Việc thay đổi đường dẫn này thực tế thường phát sinh do: khi đã tách database thành Front end và Back end thì file BE (P1.accdb) thường được lưu vào ổ đĩa mạng, share full quyền, các file FE (App.Accdb) ở các máy con sẽ kết nối vô BE này. Do đó khi ổ đĩa mạng thay chứa file BE thay đổi --> phải cập nhật lại đường dẫn.
  
  Link file: tải lại link ở bài #1
  
  

  Mã PHP:

  Option Compare Database
Option Explicit

Dim dbs As DAO.Database, tdf As DAO.TableDef
Dim StrTable As String, linkDataBase As String

Private Sub cmdData1_Click()
    changeDatabase "P1.accdb"
End Sub

Private Sub cmdData2_Click()
    changeDatabase "P2.accdb"
End Sub

Sub changeDatabase(dbName As String)
    Dim fso As Object
    Dim strConnect As String
    
    Set fso = CreateObject("Scripting.FileSystemObject")

    If fso.FileExists(CurrentProject.Path & "\" & dbName) = True Then
        Me.txtDBPath = CurrentProject.Path & "\" & dbName
    Else
        MsgBox "Khong tim thay Database" & vbCrLf & _
            "Co the file da bi xoa hoac doi duong dan. Vui long chon lai file.", vbExclamation, "Thong bao"
        Me.txtDBPath = chonDatabase
    End If
    
    If Len(Nz(Me.txtDBPath, "")) > 1 Then
        relinkTables
        DoCmd.OpenForm "HoSoThuPhi"
        DoCmd.Close acForm, "frmMain"
    Else
        MsgBox "Ban chua chon database", vbCritical, "Thông báo"
    End If
    
    Set fso = Nothing
End Sub


Function chonDatabase() As String
    Dim fDialog As Object 'Office.FileDialog

    Set fDialog = Application.FileDialog(3) '(msoFileDialogFilePicker)
    With fDialog
        .AllowMultiSelect = False  'Chi chon 1 file
        .title = "Chon Database can lien ket"
        .Filters.Clear
        .Filters.Add "Database", "*.accdb"
        .Filters.Add "All Files", "*.*"
        
        If .Show = True Then    'True: Nguoi dung da chon file, False: nguoi dung bam Cancel
            chonDatabase = .SelectedItems(1)
        Else
            chonDatabase = ""
            'MsgBox "Ban khong chon file nao."
        End If
    End With
    Set fDialog = Nothing
End Function

Sub relinkTables()
    'Dim dbs As DAO.Database, tdf As DAO.TableDef
    'Dim StrTable As String, linkDataBase As String
    Dim strAdminPWord As String, strConnect As String
    
    On Error GoTo EH
    
    
    linkDataBase = Me.txtDBPath
    If passworDB = True Then
        MsgBox "Vui long nhap mat khau database.", vbInformation, "Thông báo"
        strAdminPWord = InputBoxDK("Nhap mat khau mo khóa.", "MO KHOA DU LIEU")
        strConnect = "MS Access;PWD=" & strAdminPWord & ";DATABASE=" & linkDataBase
    Else
        strConnect = ";DATABASE=" & linkDataBase
    End If
    Debug.Print strConnect
    Set dbs = CurrentDb
    For Each tdf In CurrentDb.TableDefs
        If Len(tdf.Connect) > 1 Then 'chi relink linked tables
            If InStr(tdf.Connect, "ODBC") = 0 Or InStr(tdf.Connect, "MSys") = 0 Then 'Khong relink ODBC hoac table he thong
                StrTable = tdf.Name
                Debug.Print tdf.Connect
                dbs.TableDefs(StrTable).Connect = strConnect
                dbs.TableDefs(StrTable).RefreshLink
            End If
        End If
    Next
    MsgBox "Da link table thanh cong.", vbInformation, "Thông báo"
    
EH_Exit:
    Set dbs = Nothing
    Exit Sub
EH:
    MsgBox "Loi: " & Err.Number & vbCrLf & "No dung: " & Err.Description, vbCritical, "Relink Tables Error"
    Resume EH_Exit
    
End Sub

Function passworDB() As Boolean
    Set dbs = CurrentDb
    For Each tdf In CurrentDb.TableDefs
        If Len(tdf.Connect) > 1 Then 'chi relink linked tables
            If InStr(tdf.Connect, "ODBC") = 0 Or InStr(tdf.Connect, "MSys") = 0 Then
                If InStr(tdf.Connect, "PWD") > 0 Then
                    passworDB = True
                Else
                    passworDB = False
                End If
            End If
            Exit For
        End If
    Next
    Set dbs = Nothing
End Function 


• RE: Kết nối bảng từ access A đến access B

  hieunx > 10-04-24, 04:35 PM

  (10-04-24, 02:46 PM)ongke0711 Đã viết:

  (10-04-24, 09:37 AM)hieunx Đã viết: Nên nếu được nhờ bạn giúp thêm 1 đoạn: khi bấm nút Data1 thì mở form "hoSoThuPhi" và table thì tự động link đến table ở P1.accdb (tương tự cho data2) mà không phải xuất hiện hộp thoại chọn data nữa. Kiểu add sẵn đường dẫn đến thư mực chứa data và tự động chọn data đã chỉ định.

  
  Cái này cũng đơn giản, thêm vài dòng code thôi.
  Tôi sửa lại theo hướng:
  - Sẽ tự động link với database nếu database đó nằm cùng folder với file App.accdb mà không cần chọn đường dẫn.
  - Nếu các database (P1, P2) bị thay đổi đường dẫn hoặc đổi tên thì nó sẽ hiện hộp thoại để chọn lại đường dẫn file.
  - Nếu database có đặt mật khẩu thì nhập MK và tự kết nối.
  
  Việc thay đổi đường dẫn này thực tế thường phát sinh do: khi đã tách database thành Front end và Back end thì file BE (P1.accdb) thường được lưu vào ổ đĩa mạng, share full quyền, các file FE (App.Accdb) ở các máy con sẽ kết nối vô BE này. Do đó khi ổ đĩa mạng thay chứa file BE thay đổi --> phải cập nhật lại đường dẫn.
  
  Link file: tải lại link ở bài #1
  
  

  Mã PHP:

  Option Compare Database
Option Explicit

Dim dbs As DAO.Database, tdf As DAO.TableDef
Dim StrTable As String, linkDataBase As String

Private Sub cmdData1_Click()
    changeDatabase "P1.accdb"
End Sub

Private Sub cmdData2_Click()
    changeDatabase "P2.accdb"
End Sub

Sub changeDatabase(dbName As String)
    Dim fso As Object
    Dim strConnect As String
    
    Set fso = CreateObject("Scripting.FileSystemObject")

    If fso.FileExists(CurrentProject.Path & "\" & dbName) = True Then
        Me.txtDBPath = CurrentProject.Path & "\" & dbName
    Else
        MsgBox "Khong tim thay Database" & vbCrLf & _
            "Co the file da bi xoa hoac doi duong dan. Vui long chon lai file.", vbExclamation, "Thong bao"
        Me.txtDBPath = chonDatabase
    End If
    
    If Len(Nz(Me.txtDBPath, "")) > 1 Then
        relinkTables
        DoCmd.OpenForm "HoSoThuPhi"
        DoCmd.Close acForm, "frmMain"
    Else
        MsgBox "Ban chua chon database", vbCritical, "Thông báo"
    End If
    
    Set fso = Nothing
End Sub


Function chonDatabase() As String
    Dim fDialog As Object 'Office.FileDialog

    Set fDialog = Application.FileDialog(3) '(msoFileDialogFilePicker)
    With fDialog
        .AllowMultiSelect = False  'Chi chon 1 file
        .title = "Chon Database can lien ket"
        .Filters.Clear
        .Filters.Add "Database", "*.accdb"
        .Filters.Add "All Files", "*.*"
        
        If .Show = True Then    'True: Nguoi dung da chon file, False: nguoi dung bam Cancel
            chonDatabase = .SelectedItems(1)
        Else
            chonDatabase = ""
            'MsgBox "Ban khong chon file nao."
        End If
    End With
    Set fDialog = Nothing
End Function

Sub relinkTables()
    'Dim dbs As DAO.Database, tdf As DAO.TableDef
    'Dim StrTable As String, linkDataBase As String
    Dim strAdminPWord As String, strConnect As String
    
    On Error GoTo EH
    
    
    linkDataBase = Me.txtDBPath
    If passworDB = True Then
        MsgBox "Vui long nhap mat khau database.", vbInformation, "Thông báo"
        strAdminPWord = InputBoxDK("Nhap mat khau mo khóa.", "MO KHOA DU LIEU")
        strConnect = "MS Access;PWD=" & strAdminPWord & ";DATABASE=" & linkDataBase
    Else
        strConnect = ";DATABASE=" & linkDataBase
    End If
    Debug.Print strConnect
    Set dbs = CurrentDb
    For Each tdf In CurrentDb.TableDefs
        If Len(tdf.Connect) > 1 Then 'chi relink linked tables
            If InStr(tdf.Connect, "ODBC") = 0 Or InStr(tdf.Connect, "MSys") = 0 Then 'Khong relink ODBC hoac table he thong
                StrTable = tdf.Name
                Debug.Print tdf.Connect
                dbs.TableDefs(StrTable).Connect = strConnect
                dbs.TableDefs(StrTable).RefreshLink
            End If
        End If
    Next
    MsgBox "Da link table thanh cong.", vbInformation, "Thông báo"
    
EH_Exit:
    Set dbs = Nothing
    Exit Sub
EH:
    MsgBox "Loi: " & Err.Number & vbCrLf & "No dung: " & Err.Description, vbCritical, "Relink Tables Error"
    Resume EH_Exit
    
End Sub

Function passworDB() As Boolean
    Set dbs = CurrentDb
    For Each tdf In CurrentDb.TableDefs
        If Len(tdf.Connect) > 1 Then 'chi relink linked tables
            If InStr(tdf.Connect, "ODBC") = 0 Or InStr(tdf.Connect, "MSys") = 0 Then
                If InStr(tdf.Connect, "PWD") > 0 Then
                    passworDB = True
                Else
                    passworDB = False
                End If
            End If
            Exit For
        End If
    Next
    Set dbs = Nothing
End Function 


  
  Cảm ơn bạn rất nhiều. Mình ở SG, nếu có duyên gặp, xin phép mời cốc cafe nhé. Mong có dịp để học hỏi thêm.

• RE: Kết nối bảng từ access A đến access B

  hieunx > 11-04-24, 01:23 PM

  Mình đã sử dụng phần giúp đỡ của bạn để chạy test chương trình. Khi chạy thì chương trình báo lỗi ở đoạn Function ở Module:
  
  "Public Function NewProc(ByVal lngCode As Long, ByVal wParam As Long, ByVal lParam As Long) As LongPtr"
      
  Mình có thử bỏ đoạn code trên thì chương trình chạy ổn. Tuy nhiên phát sinh thêm vấn đề: Khi mình bấm vào data1, nếu không cùng đường dẫn với chương trình sẽ có thông báo chọn lại file nguồn. Nhưng khi mình chọn file nguôn xong --> link xong table --> chạy form "hosoThuPhi". nhưng khi mình tắt. Mở lại form "hosoThuPhi" thì phải chọn lại database. Nhờ bạn giúp mình theo hướng sau:
  Hiện tại: Khi bấm vào data1 --> nếu cùng đường dẫn với chương trình thì tự động chọn file P1.accdb (tương tự cho data2). Và khi đường dẫn thay đổi thì xuất hiện bảng chọn lại data P1 hoặc P2. Tuy nhiên khi đã chọn P1, rồi tắt chương trình mở lại, bấm vào nút data1 thì chương trình tự duyệt tới luôn vị trí lưu trữ P1.accdb đã lưu ở bước trước đó dược không ? Nếu cứ phải chọn lại thì mình sợ lại chọn nhầm data.
  Hoặc nếu được thì ở phần code bạn giúp mình chỗ nào để điền đường dẫn và tên data P1.accdb hoặc P2.accdb để mình sửa đoạn này cũng được. Xin chân thành cảm ơn.
• Bài trước Bài tiếp