Quản lý, truy vấn và lưu trữ dữ liệu ở Access từ Excel. (1 người xem)

[Hai Lúa Miền Tây]

Từ Ý tưởng của anh ThuNghi em xin mạo mụi mở topic này để các anh chị em có dịp trao đổi. Do kiến thức chấp vá nên mong các anh chị và thầy cô hướng dẫn thêm để em có dịp học hỏi nhiều hơn.

Kết nối + lưu trữ và truy vấn dữ liệu từ Excel đến Database là Access giúp cho file Excel chạy nhẹ nhàng hơn không phải lưu trữ dữ liệu nhiều.

*) Trong DataAcc có 1 bảng có tên là Table1 với các trường là

ID: Auto Number
DienGiai: Text
Ngay: Date/Time
GhiChu: Text

*) Thiết kế các form bên Excel

- Form Nhập liệu (frmNhapLieu)



*) Tạo kết nối từ file Excel đến Access Database:

Ví dụ file Access có tên DataAcc để chứa dữ liệu nằm chung với file Excel
code trong Module:

Option Private Module
Public cnn As New ADODB.Connection

Public Sub Moketnoi()
  Set cnn = New ADODB.Connection
  With cnn
      .Open "Provider=Microsoft.Jet.OLEDB.4.0; " & _
             "Data Source=" & ThisWorkbook.Path & "\DataAcc.mdb;"
  End With

End Sub

- Mở kết nối :

Private Sub UserForm_Initialize()
Moketnoi

End Sub

 

[Hai Lúa Miền Tây]

Code trong userform (frmNhapLieu)

- Lấy dữ liệu vào Excel từ Table1 của file Access

Private Sub cmdExcel_Click()
On Error Resume Next
Dim lsSQL As String, iNumCols As Integer
Dim rst As New ADODB.Recordset
    lsSQL = "select * from table1;"
    rst.Open lsSQL, cnn, adOpenStatic, adLockReadOnly
        iNumCols = rst.Fields.Count
    For i = 1 To iNumCols
        With Sheet1
            .Cells(1, i).Value = rst.Fields(i - 1).Name
            .Cells(1, i).Font.Bold = True
            .Cells(1, i).Font.ColorIndex = 5
            With .Cells(1, i).Interior
                .ColorIndex = 34
            End With
        End With
    Next

        Range("A2").CopyFromRecordset rst
      rst.Close
      Set rst = Nothing

End Sub

- Code ghi dữ liệu vào Access

Private Sub cmdGhi_Click()
Dim rst As ADODB.Recordset
Set rst = New ADODB.Recordset
    If Len(txtDienGiai) = 0 Or Len(txtNgay) = 0 Then
        MsgBox "Please enter your data !", vbCritical
        txtDienGiai.SetFocus
        Exit Sub
    Else

    rst.Open "table1", cnn, adOpenKeyset, adLockOptimistic, adCmdTable
        With rst
            .AddNew
            .Fields("DienGiai") = txtDienGiai
            .Fields("Ngay") = txtNgay
            .Fields("GhiChu") = txtGhiChu
            .Update
        End With
        txtDienGiai = ""
        txtNgay = ""
        txtGhiChu = ""
        
    rst.Close
    Set rst = Nothing
   End If

End Sub

 

[Hai Lúa Miền Tây]

Ghi dữ liệu từ cell riêng lẻ ta dùng cách sau:

Ví dụ ghi vào bảng từ những cell sau vào bảng Table1
- [B3] vào trường DienGiai
- [C6] vào trường Ngay
- [D6] vào trường GhiChu

Private Sub cmdGhi_Click()
    Dim strFileName As String, mySQL As String, objAccess As Object
    Set objAccess = CreateObject("Access.Application")
    With objAccess
        .OpenCurrentDatabase ThisWorkbook.Path & "\DataAcc.mdb"
            mySQL = "INSERT INTO Table1 (DienGiai, Ngay, GhiChu) Values(" & _
                    [B3] & ",#" & [C6] & "#,'" & [D6] & "')"
        .DoCmd.RunSQL mySQL
        .CloseCurrentDatabase
        Set objAccess = Nothing
    End With


End Sub

 

[Hai Lúa Miền Tây]

Từ Excel có thể mở 1 Table, Query, Form, Report hoặc in report đã thiết kế sẳn ở file Access:

Ví dụ code sẽ in report có tên là rTable1 ở file Access:

Private Sub cmdPrint_Click()
    Dim objAccess As Object
    Set objAccess = CreateObject("Access.Application")
    With objAccess
        .OpenCurrentDatabase ThisWorkbook.Path & "\DataAcc.mdb"
        .DoCmd.OpenReport "rTable1", acNormal
        .CloseCurrentDatabase
        Set objAccess = Nothing
    End With

End Sub

 

[Hai Lúa Miền Tây]

Lấy dữ liệu từ Table1 đưa vào ListBox và Combobox ở Userform:

Private Sub cmdGetData_Click()
On Error Resume Next
Dim lsSQL As String
Dim i As Integer
Dim rst As New ADODB.Recordset
    lsSQL = "select id,diengiai from table1;"
    If rst.State = o Then
        Moketnoi
        rst.Open lsSQL, cnn, adOpenStatic, adLockReadOnly
        coSoPhieu.Clear
        i = 0
        Do Until rst.EOF
            With coSoPhieu
                .AddItem
                .List(i, 0) = rst!ID
                .List(i, 1) = rst!diengiai
            End With
            With ListBox1
                .AddItem
                .List(i, 0) = rst!ID
                .List(i, 1) = rst!diengiai
            End With
            i = i + 1
        rst.MoveNext
       Loop
        rst.Close
        Set rst = Nothing
    End If
    
End Sub

 

[ThuNghi]

Ghi dữ liệu từ cell riêng lẻ ta dùng cách sau:

Ví dụ ghi vào bảng từ những cell sau vào bảng Table1
- [B3] vào trường DienGiai
- [C6] vào trường Ngay
- [D6] vào trường GhiChu

 .OpenCurrentDatabase ThisWorkbook.Path & "\DataAcc.mdb"
            mySQL = "INSERT INTO Table1 (DienGiai, Ngay, GhiChu) Values(" & _
                    [B3] & ",#" & [C6] & "#,'" & [D6] & "')"

Cám ơn Đỏm nhiều lắm, nấy code này rất cần thiết.
Đỏm có thể giải thích thêm về cú pháp.

Values(" & [B3] & ",#" & [C6] & "#,'" & [D6] & "')"

Nhiều dấu quá nên sợ dễ sai. Cú thể có lúc không phải là 3 ô mà là 10 ô thì thì phê.
Và

DienGiai, Ngay, GhiChu

Mình có code gì lấy tên field để khi cần chi cần for i và gán từng ô.
Một lần nữa cám ơn nhiều.
Mình sẽ làm thử 1 file với những code trên và up lên xem vận dụng thế nào.

 

[Hai Lúa Miền Tây]

Cám ơn Đỏm nhiều lắm, nấy code này rất cần thiết.
Đỏm có thể giải thích thêm về cú pháp.

Values(" & [B3] & ",#" & [C6] & "#,'" & [D6] & "')"

Nhiều dấu quá nên sợ dễ sai. Cú thể có lúc không phải là 3 ô mà là 10 ô thì thì phê.
Và

DienGiai, Ngay, GhiChu

Mình có code gì lấy tên field để khi cần chi cần for i và gán từng ô.
Một lần nữa cám ơn nhiều.
Mình sẽ làm thử 1 file với những code trên và up lên xem vận dụng thế nào.

Phát biểu Insert Into là chèn dòng mới vào các trường vào trong bảng:

INSERT INTO Table_Name (Column1,Column2,Column3,...)
Values(Value1,Value2,Value3,....)

Trong đó thứ tự giá trị cần nhập vào bảng phải tương ứng với nhau.
Ví dụ:

- Value1 được nhập vào Column1
- Value2 được nhập vào Column2
- Value3 được nhập vào Column3
- ....

Về qui định nhập liệu vào bảng như sau:
- Nhập kiểu Ngày/Tháng thì cái ngày tháng đó phải đưa vào dấu # VD: #04/05/2011#
- Nhập kiểu Text thì phải có dấu nháy đơn ' VD:'Chuổi cần nhập'
- Dạng số thì để nguyên không thêm gì hết.
Về phương pháp lấy tên trường em sẽ viết ở bài viết sau

 

[Hai Lúa Miền Tây]

Lấy tên trường của 1 bảng

Code sau đây sẽ lấy tất cả tên trường của Table1

Private Sub UserForm_Initialize()
On Error Resume Next
Dim lsSQL, strTableName As String
Dim i, iNumCols As Integer
Dim rst As New ADODB.Recordset
    lsSQL = "select * from table1;"
    If rst.State = o Then
        Moketnoi
        rst.Open lsSQL, cnn, adOpenStatic, adLockReadOnly
        iNumCols = rst.Fields.Count
        strTableName = rst.Fields(0).Name
        For i = 2 To iNumCols
           strTableName = strTableName & "," & rst.Fields(i - 1).Name
        Next
        MsgBox strTableName
        rst.Close
        Set rst = Nothing
    End If
    
End Sub

 

[ThuNghi]

Phát biểu Insert Into là chèn dòng mới vào các trường vào trong bảng:

INSERT INTO Table_Name (Column1,Column2,Column3,...)
Values(Value1,Value2,Value3,....)

Trong đó thứ tự giá trị cần nhập vào bảng phải tương ứng với nhau.
...
Về qui định nhập liệu vào bảng như sau:
- Nhập kiểu Ngày/Tháng thì cái ngày tháng đó phải đưa vào dấu # VD: #04/05/2011#
- Nhập kiểu Text thì phải có dấu nháy đơn ' VD:'Chuổi cần nhập'
- Dạng số thì để nguyên không thêm gì hết.
Về phương pháp lấy tên trường em sẽ viết ở bài viết sau

Anh làm thử 1 ví dụ trong đó
- SoCT: kiểu Text
- Ngày: Date
- DienGiai: Text.
1/ Vậy trong acc mình có thể set thế nào để sort theo ngày auto.
2/ Nếu SoCT mà trùng thì msgbox gì đó và cho phép nhập hay xóa...
Cám ơn nhiều.
Và có cách gì lấy tự động là ex kiểu gì thì tự lấy qua acc như vậy. Đỡ mất công thêm các dấu # hay ', nếu có thể thì dùng các hàm Cstr hay cvdate liệu có ổn?
Cám ơn rất nhiều.

 

[ThuNghi]

Cũng file trên tôi thêm các biến Tblname, ArFieldname thì nó báo lỗi, Đỏm xem giúp có thể vận dụng.
Biến ArrFieldName = Array("SoCT", "Ngay", "DienGiai")
và
tblName = "TblSub"
Cám ơn nhiều.

Sub cmdGhi_02()
    Dim strFileName As String, mySQL As String, tblName$, AccName$
    Dim objAccess As Object
    Dim ArrFieldName()
    tblName = "TblSub": AccName = "\DataAcc.mdb"
    ArrFieldName = Array("SoCT", "Ngay", "DienGiai")
    Set objAccess = CreateObject("Access.Application")
    With objAccess
        .OpenCurrentDatabase ThisWorkbook.Path & AccName
        For i = 1 To 1
        'MsgBox ArrFieldName(i - 1)
        mySQL = "INSERT INTO  tblSub  ArrFieldName(i-1).value Values(" & "'" & [B3] & "')"
        'mySQL = "INSERT INTO  tblSub  (SoCT, Ngay,DienGiai) Values(" & _
        "'" & [B3] & "',#" & [C6] & "#,'" & [D6] & "')"
        Next i
        '   mySQL = "INSERT INTO  tblName  (SoCT, Ngay,DienGiai) Values(" & _
                    "'" & [B3] & "',#" & [C6] & "#,'" & [D6] & "')"
        .DoCmd.RunSQL mySQL
        .CloseCurrentDatabase
        Set objAccess = Nothing
    End With

 

[Hai Lúa Miền Tây]

Cũng file trên tôi thêm các biến Tblname, ArFieldname thì nó báo lỗi, Đỏm xem giúp có thể vận dụng.
Biến ArrFieldName = Array("SoCT", "Ngay", "DienGiai")
và
tblName = "TblSub"
Cám ơn nhiều.

Sub cmdGhi_02()
    Dim strFileName As String, mySQL As String, tblName$, AccName$
    Dim objAccess As Object
    Dim ArrFieldName()
    tblName = "TblSub": AccName = "\DataAcc.mdb"
    ArrFieldName = Array("SoCT", "Ngay", "DienGiai")
    Set objAccess = CreateObject("Access.Application")
    With objAccess
        .OpenCurrentDatabase ThisWorkbook.Path & AccName
        For i = 1 To 1
        'MsgBox ArrFieldName(i - 1)
        mySQL = "INSERT INTO  tblSub  ArrFieldName(i-1).value Values(" & "'" & [B3] & "')"
        'mySQL = "INSERT INTO  tblSub  (SoCT, Ngay,DienGiai) Values(" & _
        "'" & [B3] & "',#" & [C6] & "#,'" & [D6] & "')"
        Next i
        '   mySQL = "INSERT INTO  tblName  (SoCT, Ngay,DienGiai) Values(" & _
                    "'" & [B3] & "',#" & [C6] & "#,'" & [D6] & "')"
        .DoCmd.RunSQL mySQL
        .CloseCurrentDatabase
        Set objAccess = Nothing
    End With

Chuổi trên sẽ nối lại như sau, nhưng không thể thực hiện theo cách này anh à, bởi vì khi duyệt qua 1 trường thì nó chỉ ghi được 1 giá trị của trường đó.

mySQL = "INSERT INTO  tblSub (" & ArrFieldName(i - 1) & ") Values(" & "'" & [B3] & "')"

1/ Vậy trong acc mình có thể set thế nào để sort theo ngày auto.
2/ Nếu SoCT mà trùng thì msgbox gì đó và cho phép nhập hay xóa...

1/ Thêm 1 câu SQL nữa rồi chạy nó sau khi chạy cái SQL chèn dòng.
2/ Anh vào bảng của Access ở dạng Design View đặt cái trường đó là khoá chính là được.

 

[Hai Lúa Miền Tây]

Lấy tất cả tên bảng và tên trường của mỗi bảng đưa vào Excel

Code lấy tất cả tên bảng và tên trường của mỗi bảng đưa vào Excel

Private Sub GetTableAndFieldName_Click()
Dim DB As DAO.Database, Tbl As DAO.TableDef, Rng As Range, Fld As DAO.Field
Set Rng = Range("A1")
Set DB = DAO.OpenDatabase(ThisWorkbook.Path & "\DataAcc.mdb")

For Each Tbl In DB.TableDefs
    If Tbl.Attributes = 0 Then
        Rng.Value = Tbl.Name
        Set Rng = Rng(2, 2)
            For Each Fld In Tbl.Fields
                Rng.Value = Fld.Name
                Set Rng = Rng(2, 1)
            Next Fld
        Set Rng = Rng(1, 0)
    End If
Next Tbl

DB.Close
End Sub