Kết nối, Thao tác giữa Excel và Access

Liên hệ QC
Hoàng Trọng Nghĩa

Hoàng Trọng Nghĩa

Chuyên gia GPE
Thành viên BQT
Moderator
Tham gia
17/8/08
Bài viết
8,590
Được thích
16,653
Giới tính
Nam
Tôi có 2 File Excel và Access, xin vui lòng cho hỏi, chỉ dùng code trên Excel, làm sao để chuyển mảng lọc được từ Excel qua Access và khi Access có dữ liệu, tôi muốn lọc theo điều kiện nào đó rồi gán vào một sheet của Excel thì phải làm như thế nào?

Ví dụ như cái file Excel có 5 field: MaSo, HoTen, NgaySinh, GioiTinh, NgayNhap và Access cũng có số cột tương ứng như vậy. Sau khi lọc điều kiện của Excel là cột NgayNhap thì làm sao gán mảng đã lọc này vào trong 1 table của Access và nhập tiếp theo dữ liệu có sẳn được?

Trong Nút lệnh của Excel:

Mã: 
Private Sub CommandButton1_Click()
    If ComboBox1.Text = "" Then Exit Sub
    Dim sArr, Tmp, AccArr, i As Long, j As Long, n As Long
    i = CSDL.[A65536].End(xlUp).Row
    If i = 1 Then Exit Sub
    n = 0
    sArr = CSDL.Range("A2:A" & i).Resize(, 5).Value
    ReDim AccArr(1 To UBound(sArr), 1 To 5)
    For i = 1 To UBound(sArr)
        Tmp = sArr(i, 5)
        If Tmp = CDate(ComboBox1.Text) Then
            n = n + 1
            For j = 1 To 5
                AccArr(n, j) = sArr(i, j)
            Next
        End If
    Next
   [COLOR=#ff0000][B] ''LAM SAO DE NHAP AccArr VAO FILE ACCESS???[/B][/COLOR]
End Sub

Vì chưa ứng dụng với Access nên kiến thức mình rất hạn chế, mong các bạn hướng dẫn cho mình.

Xin chân thành cảm ơn.
 

File đính kèm

  • Desktop.rar
    19.9 KB · Đọc: 210
Chỉnh sửa lần cuối bởi điều hành viên:
Để kết nối giữa Excel và Access chúng ta có nhiều cách, ở đây tôi dùng ADO.

Để dễ dàng trong việc kết nối tôi có một số hàm sau:

Function TaoChuoiKetNoi() As String

Hàm này dùng để tạo chuổi kết nối.
Các bạn có thể thêm hoặc chỉnh sửa hàm này nhằm tạo chuổi kết nối đến các CSDL khác nhau như: SQL Server, Foxpro, Access,...
Mã: 
Function TaoChuoiKetNoi() As String
    Dim sAppPath As String
    ' Cac ban co the chinh sua tuy theo yeu cau ket noi cua minh
    sAppPath = ThisWorkbook.Path
    TaoChuoiKetNoi = "Driver={Microsoft Access Driver (*.mdb)}; Dbq=" & sAppPath & "\" & DBName & "; UID=Admin; PWD=;"

End Function

Function KetNoi() As Long
Hàm KetNoi, nếu kết nối thành công thì hàm trả về giá trị là 1. Nếu không thành công hàm sẽ trả về giá trị của lỗi.

Mã: 
Function KetNoi() As Long

    On Error GoTo ErrorHandle

    Set gcnObj = CreateObject("ADODB.Connection")
    With gcnObj
        .Mode = 3                                     'i.e adModeReadWrite
        'Neu sau thoi gian nay ma khong ket noi duoc se bao loi
        .ConnectionTimeout = 30
        'CursorTypeEnum
        '--------------
        'adOpenDynamic     = 2
        'adOpenForwardOnly = 0
        'adOpenKeySet      = 1
        'adOpenStatic      = 3

        'The CursorLocationEnum:
        '-------------------------
        'adUseClient = 3 | Uses client-side cursors supplied by a local cursor library.
        'Local cursor services often will allow many features
        'that driver-supplied cursors may not,
        'so using this setting may provide an advantage
        'with respect to features that will be enabled.
        'For backward compatibility, the synonym adUseClientBatch is also supported.
        'adUseServer = 2 | Default. Uses cursors supplied by the data provider or driver.
        'These cursors are sometimes very flexible and allow
        'for additional sensitivity to changes others make to the data source.
        'However, some features of the The Microsoft Cursor Service for OLE DB,
        'such as disassociated
        'Recordset objects, cannot be simulated with server-side cursors
        'and these features will be unavailable with this setting.
        'adUseNone   = 1 | Does not use cursor services. (
        'This constant is obsolete and appears solely for the sake of backward compatibility.)
        .CursorLocation = 3
        .ConnectionString = TaoChuoiKetNoi
        .Open
    End With
    ' Neu thanh cong dat gia tri ham bang 1
    KetNoi = 1
    ' Dong ket noi lai
    gcnObj.Close

ErrorExit:

    Exit Function

ErrorHandle:
    ' Neu co loi thi dat ma loi cho ham KetNoi
    KetNoi = Err.Number
    Err.Clear
    Resume ErrorExit

End Function

Và sau đây là thủ tục xuất dữ liệu từ Excel sang Access:

Mã: 
Sub ExcelToAccess()

    Dim lLastRow As Long, i As Long
    Dim wsObj As Worksheet
    Dim arrFieldNames As Variant, arrValues As Variant, arrRecordvals As Variant
    Dim sTableName As String
    Dim lCon  As Long
    Dim oRs   As Object

    On Error GoTo ErrorHandle


    sTableName = "TB_NhanVien"

    Set wsObj = Application.ThisWorkbook.Worksheets("CSDL")
    lLastRow = FindLastRow(wsObj)

    If lLastRow = 1 Then
        ' Neu hang bang 1
        ' Co nghia la khong co du lieu nao
        MsgBox "Khong co du lieu nao de xuat." & vbCrLf & _
               "Xin kiem tra lai.", vbOKOnly + vbInformation, gcsAppName
        GoTo ErrorExit
    End If

    lCon = KetNoi
    If lCon = 1 Then
        gcnObj.Open
        arrFieldNames = Array("MaSo", "HoTen", _
                              "NgaySinh", "GioiTinh", _
                              "NgayNhap")             'Ban co the thay doi tuy theo so truong cua ban

        ' Tang toc
        SpeedOn
        ' Tao bien recordset
        Set oRs = CreateObject("ADODB.Recordset")
        oRs.CursorLocation = 3                        'adUseClient
        oRs.Open sTableName, gcnObj, 3, 4             'adOpenStatic, adLockBatchOptimistic
        arrValues = wsObj.Range("A2:E" & lLastRow)
        For i = 1 To UBound(arrValues, 1)
            If Len(arrValues(i, 1)) > 0 Then
                arrRecordvals = Array(arrValues(i, 1), arrValues(i, 2), _
                                      arrValues(i, 3), arrValues(i, 4), _
                                      arrValues(i, 5))
                oRs.AddNew arrFieldNames, arrRecordvals
                Application.StatusBar = "Ban dang nhap ban ghi " & i & "/" & (lLastRow - 1)
            End If
        Next i

        Application.StatusBar = "Dang cap nhat...Xin cho trong giay lat..."
        oRs.UpdateBatch
        MsgBox "Ban da xuat du lieu thanh cong.", vbOKOnly + vbInformation, gcsAppName

    Else
        MsgBox "Khong the ket noi voi CSDL." & vbCrLf & _
               "Xuat du lieu khong thanh cong.", vbOKOnly + vbInformation, gcsAppName
    End If

ErrorExit:

    ' Giai phong bien
    Set wsObj = Nothing
    Set oRs = Nothing
    SpeedOff
    If Not gcnObj Is Nothing Then
        If (gcnObj.State And adStateOpen) = adStateOpen Then
            gcnObj.Close
        End If
    End If
    Exit Sub

ErrorHandle:
    ' Xu ly loi tai day
    MsgBox "Co loi xay ra. Xin kiem tra lai.", vbOKOnly + vbInformation, gcsAppName
    Debug.Print Err.Number & ", " & Err.Description
    Resume ErrorExit

End Sub

Và thủ tục lấy dữ liệu từ Access đưa vào Excel:

Mã: 
Sub AccessToExcel()
    Dim lCon  As Long
    Dim sSQL  As String
    Dim adoCommand As Object                          'ADODB.Command
    Dim oRs   As Object                               'ADODB.Recordset
    Dim wsObj As Worksheet
    Dim lLastRow As Long


    Set wsObj = Application.ThisWorkbook.Worksheets("FilterFromAccess")
    lLastRow = FindLastRow(wsObj)
    lCon = KetNoi
    If lCon <> 1 Then
        MsgBox "Khong the ket noi voi CSDL." & vbCrLf & _
               "Xuat du lieu khong thanh cong.", vbOKOnly + vbInformation, gcsAppName
    Else
        ' Mo ket noi
        gcnObj.Open
        sSQL = "SELECT MaSo, HoTen, NgaySinh, GioiTinh, NgayNhap " & _
               "FROM TB_NhanVien " & _
               "WHERE MaSo='" & "HTN005" & "';"
        Set adoCommand = CreateObject("ADODB.Command")
        With adoCommand
            .CommandType = 1                          '1: adCmdText, 2: adCmdTable, 4: adCmdStoredProc
            .ActiveConnection = gcnObj
            .CommandText = sSQL
        End With
        Set oRs = CreateObject("ADODB.Recordset")
        oRs.Open adoCommand, , 3, 4
        If oRs.EOF Then
            MsgBox "Khong co record nao thoa dieu kien.", vbOKOnly + vbInformation, gcsAppName
        Else
            wsObj.Cells(lLastRow + 1, 1).CopyFromRecordset oRs
        End If

    End If

ErrorExit:
    Set adoCommand = Nothing
    Set oRs = Nothing
    Set wsObj = Nothing
    If Not gcnObj Is Nothing Then
        If (gcnObj.State And adStateOpen) = adStateOpen Then
            gcnObj.Close
        End If
    End If
    Exit Sub

ErrorHandle:
    ' Xu ly loi tai day
    MsgBox "Co loi xay ra. Xin kiem tra lai.", vbOKOnly + vbInformation, gcsAppName
    Debug.Print Err.Number & ", " & Err.Description
    Resume ErrorExit
End Sub

Lê Văn Duyệt
 

File đính kèm

  • Excel_Access.zip
    38.2 KB · Đọc: 885
Lần chỉnh sửa cuối:
Các bạn chú ý, trong quá trình làm việc với vấn đề xuất dữ liệu từ Excel sang Access các bạn chú ý đoạn mã sau:

Mã: 
        arrValues = wsObj.Range("A2:E" & lLastRow)
        For i = 1 To UBound(arrValues, 1)
            If Len(arrValues(i, 1)) > 0 Then
                arrRecordvals = Array(arrValues(i, 1), arrValues(i, 2), _
                                      arrValues(i, 3), arrValues(i, 4), _
                                      arrValues(i, 5))
                oRs.AddNew arrFieldNames, arrRecordvals
                Application.StatusBar = "Ban dang nhap ban ghi " & i & "/" & (lLastRow - 1)
            End If
        Next i

Theo kinh nghiệm bản thân tôi, đây là cách nhanh nhất.
Nếu các bạn thực hiện yêu cầu này nhưng trong Visual Basic, thì các bạn sẽ rõ.

Đối với thủ tục Sub AccessToExcel() các bạn có thể tham khảo thêm ở mục Thư viện mã lập trình

Mã: 
wsObj.Cells(lLastRow + 1, 1).CopyFromRecordset oRs
Phương thức này không áp dụng được cho Excel 97.

Lê Văn Duyệt
 
Ở đây cũng xin lưu ý, khi các bạn thiết kế CSDL trong Access, như bảng dữ liệu của minhthien, thì nên thêm vào trường ID với kiểu là AutoNumber để dễ dàng xử lý dữ liệu sau này.

Trong ví dụ trên, đối với thủ tục: Sub ExcelToAccess(), các bạn có thể lọc dữ liệu rồi sau đó mới đưa vào mảng.
Và chú ý, nếu bạn thực hiện thủ tục này, thì cũng nên kiểm tra việc trùng lắp trường MaSo.

Đối với thủ tục Sub AccessToExcel(), việc lọc dữ liệu tùy thuộc vào câu lệnh SQL

Mã: 
sSQL = "SELECT MaSo, HoTen, NgaySinh, GioiTinh, NgayNhap " & _
               "FROM TB_NhanVien " & _
               "WHERE MaSo='" & "HTN005" & "';"

Lê Văn Duyệt
 
Lần chỉnh sửa cuối:
Tuyệt quá, cảm ơn Anh Lê Văn Duyệt rất nhiều. Để em thử vận dụng sự hướng dẫn của Anh rồi tự lọc theo ý đồ của mình xem có được không, nếu có gì phát sinh, mong Anh hướng dẫn thêm nhé!

Cám ơn Anh.
 
levanduyet đã viết:
Ở đây cũng xin lưu ý, khi các bạn thiết kế CSDL trong Access, như bảng dữ liệu của minhthien, thì nên thêm vào trường ID với kiểu là AutoNumber để dễ dàng xử lý dữ liệu sau này.
Lê Văn Duyệt
Nhấp chuột vào đây để mở rộng...


Vì em không rành về Access cho lắm, sau khi vận dụng từ mảng lọc sẳn của em vào code của Anh thì OK, có một chuyện em nhờ anh giải thích là khi em thêm trường ID và chọn kiểu là AutoNumber thì khi em xóa toàn bộ Records rồi dùng code gán vô Access thì nó không cho số từ đầu mà nó vẫn cho số tiếp tục thì phải làm thế nào?
 
Hoàng Trọng Nghĩa đã viết:
Vì em không rành về Access cho lắm, sau khi vận dụng từ mảng lọc sẳn của em vào code của Anh thì OK, có một chuyện em nhờ anh giải thích là khi em thêm trường ID và chọn kiểu là AutoNumber thì khi em xóa toàn bộ Records rồi dùng code gán vô Access thì nó không cho số từ đầu mà nó vẫn cho số tiếp tục thì phải làm thế nào?
Nhấp chuột vào đây để mở rộng...
Có ảnh hưởng gì đâu em. Em vẫn giữ trường MaSo của em.

Trường ID, sau này khi em liệt kê dữ liệu, mà muốn chỉnh sửa lại bản ghi (record) này thì sẽ thuận tiện rất nhiều. Em chỉ cần tham khảo ID của bản ghi là có thể chỉnh sửa (UPDATE).

Thật sự ra khi làm việc với các bản ghi, thông thường người ta không xóa mà đưa các bản ghi này vào một bảng khác. Như vậy việc không reset lại giá trị của trường này giúp chúng ta kiểm tra lại sau này.

Lê Văn Duyệt
 
Lần chỉnh sửa cuối:
Hoàng Trọng Nghĩa đã viết:
Vì em không rành về Access cho lắm, sau khi vận dụng từ mảng lọc sẳn của em vào code của Anh thì OK, có một chuyện em nhờ anh giải thích là khi em thêm trường ID và chọn kiểu là AutoNumber thì khi em xóa toàn bộ Records rồi dùng code gán vô Access thì nó không cho số từ đầu mà nó vẫn cho số tiếp tục thì phải làm thế nào?
Nhấp chuột vào đây để mở rộng...

Theo mình biết thì có 3 cách để reset lại trường Autonumber này.
  1. Dùng code
  2. Xóa trường ID, lưu lại, thoát ra. Vào bảng dạng thiết kế, tạo lại trường ID dạng Autonumber
  3. Compact and repair Database.
 
Hai Lúa Miền Tây đã viết:
Theo mình biết thì có 3 cách để reset lại trường Autonumber này.
  1. Dùng code
  2. Xóa trường ID, lưu lại, thoát ra. Vào bảng dạng thiết kế, tạo lại trường ID dạng Autonumber
  3. Compact and repair Database.
Nhấp chuột vào đây để mở rộng...

Vậy dùng code sẽ như thế nào vậy Hai Lúa Miền Tây? Hướng dẫn cho mình luôn nhé! Cám ơn rất nhiều.
 
Hoàng Trọng Nghĩa đã viết:
Vậy dùng code sẽ như thế nào vậy Hai Lúa Miền Tây? Hướng dẫn cho mình luôn nhé! Cám ơn rất nhiều.
Nhấp chuột vào đây để mở rộng...
Đây là UDF để reset lại trường dạng Autonumber:

Mã: 
Function ChangeSeed(strTbl As String, strCol As String, lngSeed As Long) As Boolean
'strTbl = Ten Table co chua truong kieu autonumber
'strCol = Ten truong co chua autonumber
'lngSeed = Con so ma ban muon no hien thi cho dong ke tiep.

Dim cnn As ADODB.Connection
Dim cat As New ADOX.Catalog
Dim col As ADOX.Column

Set cnn = CurrentProject.Connection
cat.ActiveConnection = cnn

Set col = cat.Tables(strTbl).Columns(strCol)

col.Properties("Seed") = lngSeed
cat.Tables(strTbl).Columns.Refresh
If col.Properties("seed") = lngSeed Then
    ChangeSeed = True
Else
    ChangeSeed = False
End If
Set col = Nothing
Set cat = Nothing
Set cnn = Nothing

End Function

Lưu ý: Nhớ check vào Microsoft ADO Ext 2.x for DDL and Security Libraries trong Tools, References
 
Hai Lúa Miền Tây đã viết:
Đây là UDF để reset lại trường dạng Autonumber:

Mã: 
Function ChangeSeed(strTbl As String, strCol As String, lngSeed As Long) As Boolean
'strTbl = Ten Table co chua truong kieu autonumber
'strCol = Ten truong co chua autonumber
'lngSeed = Con so ma ban muon no hien thi cho dong ke tiep.

Dim cnn As ADODB.Connection
Dim cat As New ADOX.Catalog
Dim col As ADOX.Column

Set cnn = CurrentProject.Connection
cat.ActiveConnection = cnn

Set col = cat.Tables(strTbl).Columns(strCol)

col.Properties("Seed") = lngSeed
cat.Tables(strTbl).Columns.Refresh
If col.Properties("seed") = lngSeed Then
    ChangeSeed = True
Else
    ChangeSeed = False
End If
Set col = Nothing
Set cat = Nothing
Set cnn = Nothing

End Function

Lưu ý: Nhớ check vào Microsoft ADO Ext 2.x for DDL and Security Libraries trong Tools, References
Nhấp chuột vào đây để mở rộng...

Vì mình muốn cái file Access làm cái thùng chứa dữ liệu và cột ID đó như là STT nên không muốn mở ra và chỉ chạy code trên Excel thôi thì phải gán hàm này như thế nào trên cái file Excel vậy?
 
Hoàng Trọng Nghĩa đã viết:
Vì mình muốn cái file Access làm cái thùng chứa dữ liệu và cột ID đó như là STT nên không muốn mở ra và chỉ chạy code trên Excel thôi thì phải gán hàm này như thế nào trên cái file Excel vậy?
Nhấp chuột vào đây để mở rộng...

Nếu như vậy thì đâu cần đâu nhỉ.
Em thử dùng câu lệnh SQL sau để lấy về recordset:

Mã: 
SELECT (SELECT COUNT(s.MaSo)
FROM TB_NhanVien s
WHERE s.MaSo<=t.MaSo) As Stt, t.[HoTen]
FROM TB_NhanVien As t
ORDER BY t.MaSo;

Lê Văn Duyệt
 
levanduyet đã viết:
Nếu như vậy thì đâu cần đâu nhỉ.
Em thử dùng câu lệnh SQL sau để lấy về recordset:

Mã: 
SELECT (SELECT COUNT(s.MaSo)
FROM TB_NhanVien s
WHERE s.MaSo<=t.MaSo) As Stt, t.[HoTen]
FROM TB_NhanVien As t
ORDER BY t.MaSo;

Lê Văn Duyệt
Nhấp chuột vào đây để mở rộng...


Sẳn cho em hỏi, nếu như em muốn dùng Code để UPDATE dữ liệu như Anh nói thì cũng với cái File Access đó, em muốn xóa một hoặc nhiều records hoặc chỉnh sửa theo dữ liệu của File Excel và thực hiện trên Excel thì em phải làm sao ạ?

Em cám ơn Anh rất nhiều.
 
Hoàng Trọng Nghĩa đã viết:
Sẳn cho em hỏi, nếu như em muốn dùng Code để UPDATE dữ liệu như Anh nói thì cũng với cái File Access đó, em muốn xóa một hoặc nhiều records hoặc chỉnh sửa theo dữ liệu của File Excel và thực hiện trên Excel thì em phải làm sao ạ?

Em cám ơn Anh rất nhiều.
Nhấp chuột vào đây để mở rộng...

Cấu trúc thủ tục cũng giống như trên, em chỉ chỉnh sửa câu lệnh SQL thôi. Em xem tại đây: http://www.w3schools.com/sql/default.asp

Lê Văn Duyệt
 
levanduyet đã viết:
Nếu như vậy thì đâu cần đâu nhỉ
Em thử dùng câu lệnh SQL sau để lấy về recordset:
Mã: 
SELECT (SELECT COUNT(s.MaSo) FROM TB_NhanVien s WHERE s.MaSo<=t.MaSo) As Stt, t.[HoTen] FROM TB_NhanVien As t ORDER BY t.MaSo;
Nhấp chuột vào đây để mở rộng...


Em đã làm thử nhu code dưới và bị lỗi, em chỉ thêm 1 cột là STT là AutoNumber, còn cấu trúc khác thì giữ nguyên ạ.

Mã: 
Sub DieuKhienAccess()
    Dim lCon  As Long
    Dim sSQL  As String
    Dim adoCommand As Object                          'ADODB.Command
    Dim oRs   As Object                               'ADODB.Recordset
    Dim wsObj As Worksheet
    


    Set wsObj = Application.ThisWorkbook.Worksheets("FilterFromAccess")
   
    lCon = KetNoi
    If lCon <> 1 Then
        MsgBox "Khong the ket noi voi CSDL." & vbCrLf & _
               "Xuat du lieu khong thanh cong.", vbOKOnly + vbInformation, gcsAppName
    Else
        gcnObj.Open
 [COLOR=#0000cd][B]       sSQL = "SELECT (SELECT COUNT(s.MaSo) " & _
                "FROM TB_NhanVien s" & _
                "WHERE s.MaSo<=t.MaSo) As Stt, t.[HoTen] " & _
                "FROM TB_NhanVien As t " & _
                "ORDER BY t.MaSo;"
               [/B][/COLOR]
        Set adoCommand = CreateObject("ADODB.Command")
        With adoCommand
            .CommandType = 1                          '1: adCmdText, 2: adCmdTable, 4: adCmdStoredProc
            .ActiveConnection = gcnObj
            .CommandText = sSQL
        End With
        Set oRs = CreateObject("ADODB.Recordset")
        oRs.Open adoCommand, , 3, 4
    End If

ErrorExit:
    Set adoCommand = Nothing
    Set oRs = Nothing
    Set wsObj = Nothing
    If Not gcnObj Is Nothing Then
        If (gcnObj.State And adStateOpen) = adStateOpen Then
            gcnObj.Close
        End If
    End If
    Exit Sub

ErrorHandle:
    ' Xu ly loi tai day
    MsgBox "Co loi xay ra. Xin kiem tra lai.", vbOKOnly + vbInformation, gcsAppName
    Debug.Print Err.Number & ", " & Err.Description
    Resume ErrorExit
End Sub


Làm ơn sửa lại giúp em cho đúng thủ tục ạ.

Cám ơn Anh rất nhiều.
 
Lần chỉnh sửa cuối:
Chào em,

Mã: 
sSQL = "SELECT (SELECT COUNT(s.MaSo) " & _
               "FROM TB_NhanVien s " & _
               "WHERE s.MaSo<=t.MaSo) As Stt, t.[HoTen], t.[NgaySinh], t.[GioiTinh], t.[NgayNhap] " & _
               "FROM TB_NhanVien As t " & _
               "ORDER BY t.MaSo;"

Em chú ý có khoảng trắng ở sau
Mã: 
"FROM TB_NhanVien s " & _

Lê Văn Duyệt
 
levanduyet đã viết:
Chào em,

Mã: 
sSQL = "SELECT (SELECT COUNT(s.MaSo) " & _
               "FROM TB_NhanVien s " & _
               "WHERE s.MaSo<=t.MaSo) As Stt, t.[HoTen], t.[NgaySinh], t.[GioiTinh], t.[NgayNhap] " & _
               "FROM TB_NhanVien As t " & _
               "ORDER BY t.MaSo;"

Em chú ý có khoảng trắng ở sau
Mã: 
"FROM TB_NhanVien s " & _

Lê Văn Duyệt
Nhấp chuột vào đây để mở rộng...

Em cám ơn Anh rất nhiều, nhưng hình như code có chạy, nhưng trường STT không reset lại số 1 vậy em phải làm sao?

Mã: 
Sub DieuKhienAccess()
    Dim lCon  As Long
    Dim sSQL  As String
    Dim adoCommand As Object
    Dim oRs   As Object
    Dim wsObj As Worksheet
    
    Set wsObj = Application.ThisWorkbook.Worksheets("FilterFromAccess")
   
    lCon = KetNoi
    If lCon <> 1 Then
        MsgBox "Khong the ket noi voi CSDL." & vbCrLf & _
               "Xuat du lieu khong thanh cong.", vbOKOnly + vbInformation, gcsAppName
    Else
        gcnObj.Open
[COLOR=#0000cd]        sSQL = "SELECT (SELECT COUNT(s.MaSo) " & _
                       "FROM TB_NhanVien s " & _
                       "WHERE s.MaSo<=t.MaSo) As Stt, t.[HoTen], t.[NgaySinh], t.[GioiTinh], t.[NgayNhap] " & _
                       "FROM TB_NhanVien As t " & _
                       "ORDER BY t.MaSo;"[/COLOR]
        Set adoCommand = CreateObject("ADODB.Command")
        With adoCommand
            .CommandType = 1
            .ActiveConnection = gcnObj
            .CommandText = sSQL
        End With
        Set oRs = CreateObject("ADODB.Recordset")
        oRs.Open adoCommand, , 3, 4
    End If

ErrorExit:
    Set adoCommand = Nothing
    Set oRs = Nothing
    Set wsObj = Nothing
    If Not gcnObj Is Nothing Then
        If (gcnObj.State And adStateOpen) = adStateOpen Then
            gcnObj.Close
        End If
    End If
    Exit Sub

ErrorHandle:
    ' Xu ly loi tai day
    MsgBox "Co loi xay ra. Xin kiem tra lai.", vbOKOnly + vbInformation, gcsAppName
    Debug.Print Err.Number & ", " & Err.Description
    Resume ErrorExit
End Sub
 

File đính kèm

  • HocAccess.rar
    35.7 KB · Đọc: 134
levanduyet đã viết:
Đã nói với em, em cần gì phải reset lại, còn muốn thể hiện số thứ tự khi đưa ra thì làm như trên.

Lê Văn Duyệt
Nhấp chuột vào đây để mở rộng...

Cám ơn Anh nhiều!

Bây giờ, em muốn xóa những Record là "Nam" ở Field "GioiTinh" thì em phải làm sao và code vẫn trên Excel. Em cám ơn Anh nhiều.
 
Hoàng Trọng Nghĩa đã viết:
Cám ơn Anh nhiều!

Bây giờ, em muốn xóa những Record là "Nam" ở Field "GioiTinh" thì em phải làm sao và code vẫn trên Excel. Em cám ơn Anh nhiều.
Nhấp chuột vào đây để mở rộng...
Thì anh xoá bình thường thôi.
1.) Kết nối dữ liệu:

Mã: 
Public cnn As New ADODB.Connection
Public Sub Moketnoi()
If cnn.State <> 1 Then
  With cnn
    .ConnectionString = "Provider= Microsoft.Jet.OLEDB.4.0; data source=" & ThisWorkbook.Path & "\CSDLfromExcel.mdb"
    .CursorLocation = adUseClient
    .Open
  End With
End If
End Sub

2. Xoá dữ liệu nếu trường giới tính có giá trị là 'Nam'

Mã: 
Sub xoa()
On Error Resume Next
Dim rs As New ADODB.Recordset: Dim ktr As String
Moketnoi
   ktr = MsgBox("Ban co thet su muon xoa ?", vbQuestion + vbYesNo, "Hoi")
      If ktr = vbYes Then
         With rs
            .Source = "DELETE * FROM [TB_NhanVien] WHERE [GioiTinh] like 'Nam'"
            .ActiveConnection = cnn
            .Open
         End With
      End If
 rs.Close
 Set rs = Nothing
 cnn.Close
 Set cnn = Nothing
 
End Sub

Anh xem file nhé.

*) Anh nhớ copy nó vào chung folder của file access nhé.
 

File đính kèm

  • ExcelToAccess.xls
    78 KB · Đọc: 102
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

LuuAnh980
Sao Filter của Excel kỳ lạ.
Trả lời
9
Đọc
33
Hoàng Tuấn 868
H
H
  • Question
nhờ các bác viết mẫu cho em lệnh dùng checkbox để rút ngắn thời gian thao tác
Trả lời
10
Đọc
186
hiv174
H
hoang.buivan93
Gặp rắc rối về phần công thức hàm tìm kiếm dữ liệu. Nhờ mọi người chỉ giáo giúp ạ.
Trả lời
3
Đọc
51
VetMini
V
T
[Giúp đỡ] Tìm số lượng nhân viên đã tham gia làm lô hàng
Trả lời
3
Đọc
71
hoangtuaotrang_hp_vn
H
quangminhici
Tặng Addin Word xuất Mail Merge có chức năng cắt ra nhiều file và gửi mail.
    • Thích
Trả lời
8
Đọc
955
thientac
T
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom