Xin giới thiệu một module nhỏ cho các bạn thao tác với bảng trong Excel

[lethanhnhan]

Chào các bạn,
Tôi thấy đa số các bạn thường sử dụng trực tiếp các bảng trong Excel để lưu trữ dữ liệu. Vậy nên tôi sưu tầm được module này xin giới thiệu với các bạn. Module này sử dụng ADO để thao tác dữ liệu INSERT, UPDATE, SELECT cho worksheet, workbook, range.

Tác giả: Rafey
Đường link: http://www.codeproject.com/office/Excel_VBA_Library.asp

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Author: Rafey
'
' Comments: Use this library to use Excel sheet as database table.
'           This library could simplify INSERT, UPDATE, SELECT
'           in Excel sheet
'
'          You could use it:
'
'           1. From Excel sheet
'           2. Other VBA modules/classes/UserForms
'           3. From Excel Macros
'
' Email: syedrafey@gmail.com (Karachi, Pakistan)
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit

Public Function IsEmpty(ByRef rs) As Boolean
    If rs Is Nothing Or rs.RecordCount < 1 Then
        IsEmpty = True
    Else
        IsEmpty = False
    End If
End Function
Public Function GetConnection()
    Set GetConnection = CreateObject("ADODB.Connection")
    With GetConnection
        .Provider = "MSDASQL"
        .ConnectionString = "Driver={Microsoft Excel Driver (*.xls)};DBQ=" + AOptions.BookPath + ";ReadOnly=False;"
        .Open
    End With
    Exit Function
End Function
Public Function Show(ByRef rs)
    Dim i As Integer
    i = 1
    Do While Not rs.EOF
        Debug.Print CStr(i) + " [" + rs(0).value + "]"
        i = i + 1
        rs.MoveNext
    Loop
    rs.MoveFirst
End Function
Public Function Run(ByVal sheetName As String, Optional ByVal filter As String = "", Optional ByVal orderBy As String = "", Optional ByVal distinct As String = "")
    If filter <> "" Then
        filter = " WHERE " + filter
    End If

    If orderBy <> "" Then
        orderBy = " ORDER BY " + orderBy
    End If

    If distinct <> "" Then
        distinct = " DISTINCT " + distinct
    Else
        distinct = " * "
    End If
    Set Run = ASQL.ExecuteRun("SELECT " + distinct + " FROM [" + sheetName + "$] " + filter + orderBy)
End Function
Public Function ExecuteRun(ByVal query As String)
    Dim cn
    Dim rs
    Dim i As Integer
    Set cn = GetConnection()
    Set rs = CreateObject("ADODB.Recordset")
    rs.CursorLocation = adUseClient
    'Populate the Recordset object with a SQL query
    rs.Open query, cn, adOpenStatic, adLockBatchOptimistic
    'Show rs
    'Disconnect the Recordset
    Set rs.ActiveConnection = Nothing
    'Return the Recordset
    Set ExecuteRun = rs
    'Clean up...
    cn.Close
    Set cn = Nothing
End Function
Public Function Update(ByVal sheetName As String, ParamArray colVals() As Variant)
    Dim filter As String
    If AStr.IsEmpty(sheetName) Then
        Exit Function
    End If
    filter = ParamList(",", colVals)
    If filter <> "" Then
        filter = " WHERE " + filter
    End If
    ASQL.ExecuteRun "UPDATE [" + sheetName + "$] SET " + colVals + filter
End Function
Public Function Insert(ByVal sheetName As String, ParamArray colVals() As Variant)
    Dim i As Integer
    Dim f As String
    Dim v As String
    For i = 0 To UBound(colVals()) Step 2
        f = f + AStr.Bracket(CStr(colVals(i))) + ","
        v = v + AStr.Quote(CStr(colVals(i + 1))) + ","
    Next
    ASQL.ExecuteInsert sheetName, AStr.RemoveLast(f), AStr.RemoveLast(v)
End Function

Public Function ExecuteInsert(ByVal sheetName As String, ByVal fields As String, ByVal values As String)
    If fields = "" Or values = "" Then
        Exit Function
    End If
    ASQL.ExecuteRun "INSERT INTO [" + sheetName + "$] " + AStr.Parenthesis(fields) + " VALUES " + AStr.Parenthesis(values)
    Exit Function
End Function

Public Function GetUnique(ByVal sheetName As String, ByVal columnName As String)
    If sheetName = "" Or columnName = "" Then
        Exit Function
    End If
    Set GetUnique = ASQL.Run(sheetName, "", columnName, columnName)
End Function

Public Function Find(ByRef rs, ByVal columnName As String, ByVal value As Variant) As Boolean
    rs.MoveFirst
    Find = False
    If IsNull(value) Or ASQL.IsEmpty(rs) Then
        Exit Function
    End If
    rs.Find columnName + " = " + AStr.Quote(value)
    If (rs.BOF = True) Or (rs.EOF = True) Then
        rs.MoveFirst
    End If
    Find = True    ' yes found the value!!
End Function

Public Function Val(ByRef rs, ByVal columnName As String, Optional defaultValue As String = "") As String
    If ASQL.IsEmpty(rs) Or AStr.IsEmpty(columnName) Or IsNull(rs(columnName)) Then
        Val = defaultValue
    Else
        Val = rs(columnName)
    End If
End Function

Public Function IsEmptyVal(ByRef rs, ByVal columnName As String, Optional defaultValue As String = "") As Boolean
    IsEmptyVal = AStr.IsEmpty(ASQL.Val(rs, columnName))
End Function

Public Function Delete(ByVal sheetName As String, ParamArray filterColVals() As Variant)
    Dim filter As String
    If AStr.IsEmpty(sheetName) Then
        Exit Function
    End If
    filter = ParamList("AND", filterColVals)
    If filter <> "" Then
        filter = " WHERE " + filter
    End If
    ' do not use following statement it is not supported by Excel
    ' instead use Excel sheet filter and then clear
    '
    ' ASQL.ExecuteRun "DELETE FROM [" + sheetName + "$] " + filter
End Function

Public Function ParamListEx(ByVal operator As String, ByVal suffix As String, ParamArray colVals() As Variant)
    Dim i As Integer
    Dim fv As String
    For i = 0 To UBound(colVals()) Step 2
        fv = fv + AStr.Bracket(CStr(colVals(i))) + AStr.Space(operator) + AStr.Quote(CStr(colVals(i + 1))) + " " + suffix + " "
    Next
    ParamListEx = AStr.RemoveLast(fv, Len(suffix) + 2)    ' 2 spaces
End Function
Public Function ParamList(ByVal suffix As String, ParamArray colVals() As Variant)
    ParamList = ParamListEx("=", suffix, colVals)
End Function

Tôi sẽ giới thiệu các bạn cách sử dụng.
Sau đó code này chúng ta sẽ đưa vào Thư viện code

Lê Thanh Nhân

 

[ThuNghi]

Mong rằng Bác LeThanhNhan cho ví dụ cụ thể, nên từ đơn giản -> khó.
Cám ơn Bác nhiều lắm, muốn nghiên cứu về vấn đề này mà chưa biết bài 1 năm ở đâu.