VBA进阶-使用ADO制作数据管理系统的知识结构

使用ADO制作数据管理系统的知识结构

ADO介绍

ActiveX Data Objects (ADO) is a high-level, easy-to-use interface to
OLE DB. OLE DB is a low-level, high-performance interface to a variety
of data stores. Both ADO and OLE DB can work with relational (tabular)
and nonrelational (hierarchical or stream) data.

ADO与OLE DB都可以使用在关系型或非关系型数据操作中,不过两者的特性不同

ADO provides a layer of abstraction between your client or middle-tier
application and the low-level OLE DB interfaces. ADO uses a small set
of Automation objects to provide a simple and efficient interface to
OLE DB. This interface makes ADO a good choice for developers in
higher level languages, such as Visual Basic and VBScript, who want to
access data without having to learn the intricacies of COM and OLE DB.
在应用与底层语言之间ADO提供了一个抽象的接口,这个接口让使用高级语言的开发者有了更简单与搞笑地处理数据数据

在VBA中使用ADX.Catalog对象创建Access数据库与表

Public Sub setDatabase()
    Dim Cat As New ADOX.Catalog
    Dim SQL As String
    Dim mypath As String
    mypath = ThisWorkbook.Path
    Cat.Create ("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & mypath & "\员工管理.accdb;") '创建数据库
    SQL = "CREATE TABLE 员工档案 " _
    & "(员工编号 long primary key,姓名 text(20) not null,性别 text(1) not null,民族 text(20) not null," _
    & "部门 text(20) not null,职务 text(20),电话 text(20),学历 text(20),出生日期 date not null)"
    Cat.ActiveConnection.Execute SQL '创建数据表
    Set Cat = Nothing
End Sub

对数据进行增\删\改字段操作

Public Sub TestAlterDrop()
    Dim cnn As New ADODB.Connection
    Dim rst As New ADODB.Recordset
    Dim SQL As String
    Dim i As Integer
    
    cnn.Open "Provider=Microsoft.ace.oledb.12.0;Data Source=C:\Users\xiebin\Desktop\整装待发\VBA之旅\185SQL-Alter的使用\员工管理.accdb"
    On Error Resume Next
    SQL = "ALTER TABLE 员工档案 DROP 电子邮箱,工作时间"
    cnn.Execute SQL
    On Error GoTo 0
    SQL = "ALTER TABLE 员工档案 ADD 电子邮箱 text(20),工作时间 date"
    cnn.Execute SQL
    MsgBox "增加了两列"
    SQL = "ALTER TABLE 员工档案 ALTER 工作时间 text(20)"
    cnn.Execute SQL
    MsgBox "修改了工作时间列"
    Set rst = cnn.OpenSchema(adSchemaColumns, Array(Empty, Empty, "员工档案", Empty))
    Range("A2").CopyFromRecordset rst
    For i = 0 To rst.Fields.Count - 1
        Cells(1, i + 1) = rst.Fields(i).Name
    Next
    rst.Close
    cnn.Close
    Set rst = Nothing
    Set cnn = Nothing
End Sub

该操作不难,只要连接了数据库后执行相应的SQL语句就好了,只需要用到ADO对象.

ADO对象与ADOX对象的差别

Microsoft® ActiveX® Data Objects Extensions for Data Definition Language and Security (ADOX) is an extension to the ADO objects and programming model. ADOX includes objects for schema creation and modification, as well as security. Because it is an object-based approach to schema manipulation, you can write code that will work against various data sources regardless of differences in their native syntaxes.
ADOX是ADO的以可扩展对象和程序模型.它包含的了schema对象也就是说能对数据库进行更高级的操作,比如创建数据库

查询EXCEL中的数据导入

Public Sub CreateNewDataTable()
    Dim cnn As New ADODB.Connection
    Dim rst As New ADODB.Recordset
    Dim SQL As String
    
    cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\Users\xiebin\Desktop\整装待发\VBA之旅\186查询生成新的工作表\员工管理.accdb"
    Set rst = cnn.OpenSchema(adSchemaTables, Array(Empty, Empty, "员工档案", Empty))
    If Not rst.BOF Then
        SQL = "DROP TABLE 员工档案"
        cnn.Execute SQL
    End If
    SQL = "Select * INTO 员工档案 FROM [Excel 12.0;Database=C:\Users\xiebin\Desktop\整装待发\VBA之旅\186查询生成新的工作表\CreateNewDataTable.xlsm].[Sheet1$]"
    cnn.Execute SQL
    rst.Close
    cnn.Close
    Set rst = Nothing
    Set cnn = Nothing
End Sub

Open.Shcema方法可以获取数据库Shcema下的对象信息,这里是获取表的属性信息判断要生成的表是否存在,因为SQL语法中SELECT INTO生成的新表如果存在的话会报错.上面的代码可以把excel中的数据存放到Access数据库中.

批量删除记录

TODO

批量添加记录

Public Sub MultiAddData() '思考避免重复记录
    Dim cnn As New ADODB.Connection
    Dim rst As New ADODB.Recordset
    Dim SQL As String
    
    cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\Users\xiebin\Desktop\整装待发\VBA之旅\188从表或查询中批量向数据表添加记录\员工管理.accdb"
    SQL = "insert into 员工档案(员工编号,姓名,性别,民族,部门,职务,电话,学历,出生日期,籍贯,简历)" _
    & "select * from [Excel 12.0;Database=C:\Users\xiebin\Desktop\整装待发\VBA之旅\188从表或查询中批量向数据表添加记录\188MultiAddRecords.xlsm].[Sheet1$]"
    cnn.Execute SQL
    
    cnn.Close
    Set cnn = Nothing
    
End Sub

注意INSERT INTO 与 SELECT INTO 的差别

Public Sub MultiUpdateRecords()
    Dim cnn As New ADODB.Connection
    Dim rst As New ADODB.Recordset
    Dim strTemp As String
    Dim i As Integer
    Dim aField As Variant
    Dim SQL As String
    aField = Range("A1:K1")
    For i = 2 To UBound(aField, 2) - 1
        strTemp = strTemp & ",a." & aField(1, i) & "=b." & aField(1, i)
    Next
    cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\Users\xiebin\Desktop\整装待发\VBA之旅\189批量修改数据表中的记录\员工管理.accdb"
    SQL = "UPDATE 员工档案 a,[Excel 12.0;IMEX=1Database=C:\Users\xiebin\Desktop\整装待发\VBA之旅\189批量修改数据表中的记录\189MultiUpdateRecords.xlsm;].[Sheet1$] b SET " & Mid(strTemp, 2) & " WHERE a.员工编号=b.员工编号"
    cnn.Execute SQL
    
End Sub

SQL语法是UPDATE table SET a.c1=b.c1,a.c2=b.c2 WHERE criteria.FOR循环是便捷地获取两表匹配的字段名

使用JOIN方法添加记录

'仅展示SQL语句
SELECT A.* FROM tb1 A LEFT JOIN tb2 B ON A.c1 = B.c1 WHERE B.c1 IS NULL

使用改方法时需要判断A表中是否包含记录,可以先进行判断

使用SQL查询创建透视表

//暂时不用

提取两表的相同项或不同项

Public Sub SameItemDiffItem()
    Dim cnn As New ADODB.Connection
    Dim rst As New ADODB.Recordset
    Dim SQL As String
    Dim TWBpath As String
    Dim i As Integer
    
    TWBpath = ThisWorkbook.FullName
    Sheets(3).Cells.ClearContents
    cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & TWBpath
    SQL = "SELECT A.* FROM [Sheet1$] A,[Sheet2$] B WHERE A.员工编号=B.员工编号"
    Set rst = cnn.Execute(SQL)
    Sheets(3).Range("A1") = "两表相同项"
    For i = 0 To rst.Fields.Count - 1
        Sheets(3).Cells(2, i + 1) = rst.Fields(i).Name
    Next
    Sheets(3).Range("A3").CopyFromRecordset rst
    
    SQL = "SELECT A.* FROM [Sheet1$] A LEFT JOIN [Sheet2$] B ON A.员工编号=B.员工编号 WHERE b.员工编号 IS NULL"
    Set rst = cnn.Execute(SQL)
    Sheets(3).Range("G1") = "1表独有"
    For i = 0 To rst.Fields.Count - 1
        Sheets(3).Cells(2, i + 7) = rst.Fields(i).Name
    Next
    Sheets(3).Range("G3").CopyFromRecordset rst
    
    SQL = "SELECT A.* FROM [Sheet2$] A LEFT JOIN [Sheet1$] B ON A.员工编号=B.员工编号 WHERE b.员工编号 IS NULL"
    Set rst = cnn.Execute(SQL)
    Sheets(3).Range("M1") = "2表独有"
    For i = 0 To rst.Fields.Count - 1
        Sheets(3).Cells(2, i + 13) = rst.Fields(i).Name
    Next
    Sheets(3).Range("M3").CopyFromRecordset rst
    
    rst.Close
    cnn.Close
    Set rst = Nothing
    Set cnn = Nothing
    
End Sub

这是对上面JOIN方法的补充,这里描述的比较全

对不同类型的表进行连接后关联查询

Public Sub InternalLinksQuery()
    Dim cnn As New ADODB.Connection
    Dim rst As New ADODB.Recordset
    Dim SQL, SQL1 As String
    Dim ArchivesTable1, ArchivesTable2, BonusTable1, BonusTable2, DonationsTable As String
    Dim mypath As String
    mypath = ThisWorkbook.Path
    ArchivesTable1 = "员工档案"
    ArchivesTable2 = "[Excel 12.0;DataBase=" & mypath & "\临聘人员档案.xlsx;].[Sheet1$]"
    BonusTable1 = "[MS Access;pwd=;DataBase=" & mypath & "\奖金.accdb;].奖金名单"
    BonusTable2 = "[Excel 12.0;DataBase=" & mypath & "\临聘人员奖金.xlsx;].[Sheet1$]"
    DonationsTable = "[Text;HDR=YES;Database=" & mypath & ";].[捐款.txt]"
    Cells.ClearContents
    
    cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & mypath & "\员工管理.accdb"
    
    SQL1 = "SELECT 员工编号 as 编号,姓名,性别,'员工' as 人员类别 FROM " & ArchivesTable1 & _
           " UNION ALL SELECT 编号,姓名,性别,'临聘人员' as 人员类别 FROM " & ArchivesTable2
    Set rst = cnn.Execute(SQL1)
    Range("A2").CopyFromRecordset rst
    
    SQL2 = "SELECT 员工编号 as 编号,姓名,奖金额,0 as 捐款 FROM " & BonusTable1 _
        & " UNION ALL SELECT 编号,姓名,奖金额,0 as 捐款 FROM " & BonusTable2 _
        & " UNION ALL SELECT 编号,姓名,0 as 奖金额,捐款 FROM " & DonationsTable
    Set rst = cnn.Execute(SQL2)
    Range("F2").CopyFromRecordset rst
    
    SQL = "SELECT A.编号,A.姓名,A.性别,A.人员类别,SUM(B.奖金额) as 奖金额,SUM(B.捐款) as 捐款 FROM (" & SQL1 _
        & ") A INNER JOIN (" & SQL2 & ") B" & " ON A.编号=B.编号 GROUP BY A.编号,A.姓名,A.性别,A.人员类别"
    Set rst = cnn.Execute(SQL)
    Range("L2").CopyFromRecordset rst
    rst.Close
    cnn.Close
    Set rst = Nothing
    Set cnn = Nothing
    
    
End Sub

方法还是用到JOIN那套方法,不过涉及到的表类型也比较多,考虑到后续管理系统要连接不同类型的表,这个技巧还是有参考意义的.

创建视图

Public Sub CreateView()
    Dim cnn As New ADODB.Connection
    Dim rst As New ADODB.Recordset
    Dim i As Integer
    Dim SQL As String
    Dim mypath As String
    
    mypath = ThisWorkbook.Path & "\员工管理.accdb"
    cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & mypath
    
    Set rst = cnn.OpenSchema(adSchemaTables, Array(Empty, Empty, "当月生日", "VIEW"))
    If Not rst.EOF Then
        Debug.Print "是否rst.EOF 为False"
        SQL = "DROP TABLE 当月生日"
        cnn.Execute (SQL)
    End If
    
    For i = 0 To rst.Fields.Count - 1
        Cells(1, i + 1) = rst.Fields(i).Name
    Next
    Range("A2").CopyFromRecordset rst
    SQL = "CREATE VIEW 当月生日 AS SELECT * FROM 员工档案 WHERE Month(出生日期) = Month(now)"
    cnn.Execute (SQL)
    
    rst.Close
    cnn.Close
    Set rst = Nothing
    Set cnn = Nothing
    
    
End Sub

视图是虚拟的表.与包含数据的表不一样,视图只包含使用时动态检索数据的查询.一定程度上简化SQL操作还可以更改数据的格式,算是拓展技巧.

创建交叉列联表

Public Sub TRANSFROM()
    Dim cnn As New ADODB.Connection
    Dim rst As New ADODB.Recordset
    Dim SQL As String
    Dim mypath As String
    Dim i As Integer
    Sheets("Sheet2").Cells.ClearContents
    mypath = ThisWorkbook.FullName
    cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & mypath
    SQL = "TRANSFORM sum(销售额) SELECT 姓名,SUM(销售额) As 合计 FROM [Sheet1$] GROUP BY 姓名,FORMAT(日期,'mm月') PIVOT FORMAT(日期,'mm月')"
    'SQL = "SELECT 姓名,FORMAT(日期,'mm月') As 月份,SUM(销售额) As 合计 FROM [Sheet1$] GROUP BY 姓名,FORMAT(日期,'mm月')"
    rst.Open SQL, cnn, adOpenKeyset, adLockOptimistic
    For i = 0 To rst.Fields.Count - 1
        Sheets("Sheet2").Cells(1, i + 1) = rst.Fields(i).Name
    Next
    Sheets("Sheet2").Range("A2").CopyFromRecordset rst
    rst.Close
    cnn.Close
    Set rst = Nothing
    Set cnn = Nothing
    
End Sub

与数据透视表相似

动态创建连接表

Sub LinkExcel()
    Dim Cat As New ADOX.Catalog
    Dim cnn As New ADODB.Connection
    Dim mytable As New Table
    
    cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=new.accdb"
    Set Cat.ActiveConnection = cnn
    With mytable
        .Name = "三追数据表"
        .ParentCatalog = Cat
        .Properties("Jet OLEDB:Link DataSource").Value = "C:\Users\xiebin\Desktop\整装待发\VBA之旅\201动态创建连接表\Link.xlsx"
        .Properties("Jet OLEDB:Remote Table Name").Value = "Sheet1$"
        .Properties("Jet OLEDB:Link Provider String").Value = "Excel 12.0;HDR=Yes"
        .Properties("Jet OLEDB:Create Link").Value = True
    Cat.Tables.Append mytable
    End With
End Sub

方便多人使用数据管理系统,比如在局域网中多人对数据表进行读写.

挖坑:上诉的总结使用的数据部分没有太详细会让人看的比较吃力,如果有时间会对该文章进行修改并且后续会模仿一个数据管理系统

©️2020 CSDN 皮肤主题: 点我我会动 设计师:上身试试 返回首页