VBA连接中连接sql-access等数据的方法

VBA连接中连接sql，access等数据的方法收藏DimCNNAsNewADODB.Connection定义一个新的ADO对象连接DimRSTAsNewADODB.Recordset定义一个ADO对象数据集DimStpath,strSQLAsString定义路径、查询变量Stpath=ThisWorkbook.Path&Application.PathSeparator&学生档案.mdb定义路径及文件名CNN.Openprovider=Microsoft.jet.OLEDB.4.0;datasource=&Stpath'&;JetOLEDB:DatabasePassword=&123打开链接：provider=Microsoft.jet.OLEDB.4.0是软件提供者为Microsoft.jet.OLEDB.4.0datasource=&Stpath是链接数据源为StpathJetOLEDB:DatabasePassword=&123是如果ACCESS数据库设置有保护密码，此句必不可少IfComboBox3.Value=Then如果性别的框中为空则strSQL=Select*from档案WHERE籍贯LIKE'&ComboBox2.Value&'从档案表中查找籍贯为ComboBox2的记录Select*是查找所有符合条件的字段,如果想查找符合条件并显示出具体字段,可以用SELECT字段名1,字段名2....from档案是从档案表中查找符合籍贯LIKE'&ComboBox2.Value&'的记录WHERE后为查找的条件ElseIfComboBox2.Value=ThenstrSQL=Select*from档案WHERE性别LIKE'&ComboBox3.Value&'ElsestrSQL=Select*from档案WHERE性别LIKE'&ComboBox3.Value&'&AND籍贯LIKE'&ComboBox2.Value&'EndIf以上几句为当选取项目不同时设置不同的查找语句RST.OpenstrSQL,CNN打开记录集recordset.OpenSource(来记录来源),ActiveConnection(打开的链接)Sheet1.Range(A2:G100).ClearContentsSheet1.Cells(2,1).CopyFromRecordsetRSTCopyFromRecordset方法将一个ADO或DAORecordset对象的内容复制到工作表中，复制的起始位置在指定区域的左上角,Sheet1.Cells(2,1).CopyFromRecordsetRST为把查找到的记录得制到以Sheet1.Cells(2,1)为顶点的单元格区域中RST.Close关闭记录集SetRST=Nothing释放对象变量SetCNN=Nothing2：实现查询功能（ADO+SQL）OnErrorGoTo100IfTextBox1.Text=ThenMsgBox请输入姓名,1+16,系统提示TextBox1.SetFocusElseDimCNNAsNewADODB.ConnectionDimRSTAsNewADODB.RecordsetDimStpath,strSQLAsStringStpath=ThisWorkbook.Path&Application.PathSeparator&学生档案.mdbCNN.Openprovider=Microsoft.jet.OLEDB.4.0;datasource=&Stpath'&;JetOLEDB:DatabasePassword=&123strSQL=Select*from档案WHERE姓名LIKE'&TextBox1.Value&'RST.OpenstrSQL,CNNTextBox2.Value=RST.Fields(年龄).ValueTextBox4.Value=RST.Fields(性别).ValueTextBox5.Value=RST.Fields(籍贯).ValueRST.CloseSetRST=NothingSetCNN=NothingEndIfExitSub100:MsgBox找不到符合条件的记录,1+16,系统提示实现查询功能（DAO）OnErrorGoTo100IfTextBox1.Text=ThenMsgBox请输入姓名,1+16,系统提示TextBox1.SetFocusElseDimRS1AsRecordsetDimDB1AsDatabaseSetDB1=OpenDatabase(ThisWorkbook.Path&\&学生档案.MDB)SetRS1=DB1.OpenRecordset(Name:=档案,Type:=dbOpenDynaset)RS1.FindFirst姓名='&TextBox1.Value&'IfRS1.NoMatch=TrueThenMsgBox对不起，没有该记录RS1.CloseExitSubElseTextBox2.Value=RS1.Fields(年龄).ValueTextBox4.Value=RS1.Fields(性别).ValueTextBox5.Value=RS1.Fields(籍贯).ValueTextBox6.Value=RS1.Fields(联系电话).ValueEndIfRS1.CloseSetRS1=NothingSetDB1=NothingEndIfExitSub100:MsgBox找不到符合条件的记录,1+16,系统提示3：实现数据输入功能（利用DAO）代码：DimRS1AsRecordsetDimDB1AsDatabaseOnErrorGoTo1000SetDB1=OpenDatabase(ThisWorkbook.Path&\&学生档案.MDB)RS1=DB1.OpenRecordset(Name:=档案,Type:=dbOpenDynaset)WithRS1.AddNew.Fields(姓名).Value=Me.TextBox1.Value.Fields(年龄).Value=Me.TextBox2.Value.Fields(性别).Value=Me.TextBox4.Value.Fields(籍贯).Value=Me.TextBox5.Value.Fields(联系电话).Value=Me.TextBox6.Value.UpdateMsgBox档案表中增加了一条记录!EndWithDB1.CloseExitSub4：实现修改指定记录功能OnErrorGoTo100IfTextBox1.Text=ThenMsgBox请输入姓名,1+16,系统提示TextBox1.SetFocusElseDimRS1AsRecordsetDimDB1AsDatabaseSetDB1=OpenDatabase(ThisWorkbook.Path&\&学生档案.MDB)SetRS1=DB1.OpenRecordset(Name:=档案,Type:=dbOpenDynaset)RS1.FindFirst姓名='&TextBox1.Value&'RS1.EditRS1.Fields(年龄).Value=TextBox2.ValueRS1.Fields(性别).Value=TextBox4.ValueRS1.Fields(籍贯).Value=TextBox5.ValueRS1.Fields(联系电话).Value=TextBox6.ValueRS1.UpdateRS1.CloseSetRS1=NothingSetDB1=NothingEndIfExitSub100:MsgBox找不到符合条件的记录,1+64,系统提示5：实现删除指定记录功能OnErrorGoTo100IfTextBox1.Text=ThenMsgBox请输入姓名,1+16,系统提示TextBox1.SetFocusElseDimRS1AsRecordsetDimDB1AsDatabaseSetDB1=OpenDatabase(ThisWorkbook.Path&\&学生档案.MDB)SetRS1=DB1.OpenRecordset(Name:=档案,Type:=dbOpenDynaset)RS1.FindFirst姓名='&TextBox1.Value&'RS1.DeleteRS1.UpdateRS1.CloseSetRS1=NothingSetDB1=NothingEndIfExitSub100:MsgBox找不到符合条件的记录,1+64,系统提示6：实现排序功能例：查询结果按年龄字段排序strSQL=Select*from档案WHERE性别LIKE'&ComboBox3.Value&'改为升序排列（默认）strSQL=Select*from档案WHERE籍贯LIKE'&ComboBox3.Value&'ORDERBY年龄降序排列strSQL=Select*from档案WHERE籍贯LIKE'&ComboBox2.Value&'ORDERBY年龄DESC7：实现分类汇总功能DimCNNAsNewADODB.ConnectionDimRSTAsNewADODB.RecordsetDimStpath,strSQLAsStringStpath=ThisWorkbook.Path&Application.PathSeparator&学生档案.mdbCNN.Openprovider=Microsoft.jet.OLEDB.4.0;datasource=&Stpath'&;JetOLEDB:DatabasePassword=&123strSQL=SELECT籍贯,性别,COUNT(性别)FROM档案GROUPBY籍贯,性别RST.OpenstrSQL,CNNSheet1.Range(A2:G100).ClearContentsSheet1.Cells(2,1).CopyFromRecordsetRSTRST.CloseSetRST=NothingSetCNN=Nothing