Excel自连接数据类？

Option Explicit'这个函数不好用，数据连接打开后不能关闭，否则记录集无法操作Public Function GetRecordsetForSQL(ByVal Sql As String) As ADODB.Recordset        Dim Cnn As New ADODB.Connection     '定义数据库类变量    Dim Rst As New ADODB.Recordset    With Cnn        .Provider = "Microsoft.Jet.OLEDB.4.0"        .Properties("Extended Properties").value = "Excel 8.0"        .Properties("data Source").value = ThisWorkbook.FullName                .Open                Rst.Open Sql, Cnn, 3, 4                With Rst                      Set GetRecordsetForSQL = Rst                End With            End WithEnd FunctionPublic Function GetDwmcArray() As String()    Dim dwmc() As String    dwmc = Sheets("xtdw").Range("a2:a6")    MsgBox dwmc(1), vbInformation, "提示"    End Function'ADODB方式连接SqlServer数据库'数据库连接方法:'连接数据库，返回数据连接'数据源为本工作簿Public Function GetConnExcel1() As Connection        Dim conn As New ADODB.Connection     '定义数据库类变量    Set conn = New ADODB.Connection        Dim connstr As String    connstr = "Provider=Microsoft.Jet.Oledb.4.0;Extended Properties=Excel 8.0;Data Source=" & ThisWorkbook.FullName        conn.Open connstr        If conn Is Nothing Then        Set GetConnExcel1 = Nothing    Else        Set GetConnExcel1 = conn    End If    End Function'ADODB方式连接SqlServer数据库'数据库连接方法:'连接数据库，返回数据连接'数据源为本工作簿Public Function GetConnExcel() As Connection        Dim conn As New ADODB.Connection     '定义数据库类变量    Set conn = New ADODB.Connection        With conn                .Provider = "Microsoft.Jet.OLEDB.4.0"        '.IMEX = 1        .Properties("Extended Properties").value = "Excel 8.0"        .Properties("data Source").value = ThisWorkbook.FullName        .Open            End With        If conn Is Nothing Then        Set GetConnExcel = Nothing    Else        Set GetConnExcel = conn    End If    End Function'关闭数据库连接方法代码如下'此函数多余Public Function closeConnection(ByVal conn As Connection)    If Not conn Is Nothing Then            conn.Close        End IfEnd Function'其中，参数 conn ：要关闭的连接。'执行查询语句的方法代码如下：（返回rs数据集）Public Function ExecuteQuery(ByVal conn As Connection, querySql As String) As Recordset        Dim rs As ADODB.Recordset    Set rs = New ADODB.Recordset        If Not conn Is Nothing Then            rs.Open querySql, conn, 3, 3            End If            Set ExecuteQuery = rs    End Function'''expresswhere---条件表达式，不带where'''示例－－－“dwxh = 2”Public Function GetQuerySQLString(ByVal sheetName As String, _    ByVal fristcolumn As String, _    ByVal endcolumn As String, _    ByVal queryfields As String, _    ByVal expresswhere As String) As String        Dim Sql As String        Sql = "select " & queryfields & " from [" & sheetName & "$" & fristcolumn & ":" & endcolumn & "]"        If expresswhere <> "" Then        Sql = Sql & " where " & expresswhere    End If            GetQuerySQLString = SqlEnd Function'其中，参数 conn ：数据库连接、querySql ：查询语句。返回值为查询结果集。''添加新记录'Public Function AddNewRecord(ByVal conn As ADODB.Connection, ByVal sql As String)''End FunctionSub ADO法()    Dim Cnn As Object, Sql$, f$    Set Cnn = CreateObject("ADODB.Connection")    Cnn.Open "Provider=Microsoft.Jet.Oledb.4.0;Extended Properties=Excel 8.0;Data Source=" & ThisWorkbook.FullName    f = ThisWorkbook.path & "\模拟效果\" & ActiveSheet.name & ".xls"    If Dir(f) <> "" Then Kill f    Sql = "select * into [" & f & "]." & ActiveSheet.name & " from [" & ActiveSheet.name & "$a:f]"    Cnn.Execute Sql    Cnn.Close    Set Cnn = Nothing    MsgBox "ok"End Sub