ExcelVBAADOSQL实例集锦.doc

1, 包含空值的记录 f13 is null ‘ Sub Worksheet_Activate() On Error Resume Next Dim x As Object, yy As Object, sql As String Set x = CreateObject("ADODB.Connection") x.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;hdr=no;';Data Source=" & ActiveWorkbook.FullName sql = "select f6,f2,f3,f4,f5,f7,f13,f24 -f25 from [sheet1$] where f24 -f25'C3' or f13 is null)" ‘不等于字符串用 ‘C3’ 包含空值用 is null Set yy = x.Execute(sql) Range("a:h").ClearContents Range("a1:h1") = Array("编号", "品名", "规格", "产地", "单位", "件装", "属性", "计划") ‘表头 另外赋值 [a2].CopyFromRecordset yy Set yy = Nothing Set x = NothingEnd Sub2，用ADO Connection对象查询Option ExplicitPublic conn As ADODB.ConnectionSub Myquery()Dim sConnect$, sql1$Set conn = CreateObject("adodb.connection")Sheets("sheet1").Cells.ClearContentssConnect = "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;" & _ "Data Source=" & ThisWorkbook.Path & "\" & ThisWorkbook.Namesql1 = "select 物料代码,物料描述,属性,单位 from [物料代码表$] where 属性= '采购' " '表格名要用[$],条件部分用单引号'' ThisWorkbook.Sheets("sheet1").Cells(2, 1).CopyFromRecordset conn.Execute(sql1) 'copy后面紧接SQL查询执行语句 With Sheets("sheet1") .Range("A1") = "物料代码" '建立表头 .Range("B1") = "物料描述" .Range("C1") = "属性" .Range("D1") = "单位" End With 'conn.Close '可不用每次关闭数据源的连接End Sub3，用记录集执行单个查询Option ExplicitSub Myquery()Dim rd As ADODB.RecordsetDim i%, j%, k%, sConnect$, sql1$, str$Set rd = New ADODB.Recordsetstr = "外协"Sheets("sheet1").Cells.ClearContentssConnect = "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;" & _ "Data Source=" & ThisWorkbook.Path & "\" & ThisWorkbook.Name 'conn.Open sConnect '打开数据源 sql1 = "select 物料代码,物料描述,属性,单位 from [物料代码表$] where 属性= '采购' " '表格名要用[$],条件部分用单引号'' rd.Open sql1, sConnect, adOpenForwardOnly, adLockReadOnly ThisWorkbook.Sheets("sheet1").Cells(2, 1).CopyFromRecordset rd With Sheets("sheet1") .Range("A1") = "物料代码" '建立表头 .Range("B1") = "物料描述" .Range("C1") = "属性" .Range("D1") = "单位" End With rd.Close '关闭记录集 Set rd=Nothing '关闭End Sub4，引用一列，如A列‘引用单列、单行、单个单元格.xls'引用一列，如A列Sub onecolumn() Dim Sql$ Set Conn = CreateObject("Adodb.Connection") Conn.Open "provider=microsoft.jet.oledb.4.0;extended properties='excel 8.0;hdr=no';data source=" & ThisWorkbook.Path & "\1.xls" Sql = "select f1 from [sheet1$]" Cells.Clear [a1].CopyFromRecordset Conn.Execute(Sql) Conn.Close Set Conn = NothingEnd SubSub dgzbhz()'2008/12/2‘ Dim Sql$ Set Conn = CreateObject("Adodb.Connection") [b2:d4] = "" arr = Array("一中", "二中", "三中") For i = 0 To UBound(arr) Conn.Open "provider=microsoft.jet.oledb.4.0;extended properties='excel 8.0;hdr=no';data source=" & ThisWorkbook.Path & "\" & arr(i) & ".xls" Sql = "select f2 from [sheet1$]" Cells(1, i + 2).CopyFromRecordset Conn.Execute(Sql) Conn.Close Next i Set Conn = Nothing [b1:d1] = arrEnd Sub‘test1203.xls EH‘有标题不用hdr=no，列名用编码文字，可往下连续取数据。

Private Function cnn() As Object Set cnn = CreateObject("ADODB.Connection") cnn.Open "Provider=Microsoft.Jet.Oledb.4.0;Extended Properties ='Excel 8.0;HDR=no';Data Source= " & ThisWorkbook.FullNameEnd FunctionSub onecolumn() Dim Sql$, Sht1 As Worksheet, Sht As Worksheet Dim n Set Sht1 = Sheets("汇总") Sht1.Activate ‘Set Conn = CreateObject("Adodb.Connection") ‘Conn.Open "provider=microsoft.jet.oledb.4.0;extended properties='excel 8.0';data source=" & ThisWorkbook.FullName For Each Sht In Sheets If Sht.Name <> "汇总" Then Sql = "select 编码 from [" & Sht.Name & "$]" n = [b65536].End(xlUp).Row + 1 Sht1.Cells(n, 2).CopyFromRecordset Cnn.Execute(Sql) End If Next Sht Cnn.Close Set Cnn = NothingEnd Sub5，引用一行,如第1行'引用一Sub onerow() Dim Sql$ Set Conn = CreateObject("Adodb.Connection") Conn.Open "provider=microsoft.jet.oledb.4.0;extended properties='excel 8.0;hdr=no';data source=" & ThisWorkbook.Path & "\1.xls" Sql = "select * from [sheet1$a1:iv1]" Cells.Clear [a1].CopyFromRecordset Conn.Execute(Sql) Conn.Close Set Conn = NothingEnd Sub6，引用一个单元格，如 k1 单元格‘2013-3-14‘ Dim Sql$, ConnSub testit()Dim myPath$, mvvar, i&, myName$, Myr&Sheet1.Activate[a4:h500].ClearContentsSet Conn = CreateObject("Adodb.Connection")myPa。