Excel-VBA-ADO+SQL实例集锦

1,包含空值的记录f13isnull‘=5&ID=46032&page=1‘订单生成系统.xls‘f6-第6列，f2-第2列PrivateSubWorksheet_Activate()OnErrorResumeNextDimxAsObject,yyAsObject,sqlAsStringSetx=CreateObject(ADODB.Connection)x.OpenProvider=Microsoft.Jet.OLEDB.4.0;ExtendedProperties='Excel8.0;hdr=no;';DataSource=&ActiveWorkbook.FullNamesql=selectf6,f2,f3,f4,f5,f7,f13,f24-f25from[sheet1$]wheref24-f25f17and(f13'C3'orf13isnull)‘不等于字符串用‘C3’包含空值用isnullSetyy=x.Execute(sql)Range(a:h).ClearContentsRange(a1:h1)=Array(编号,品名,规格,产地,单位,件装,属性,计划)‘表头另外赋值[a2].CopyFromRecordsetyySetyy=NothingSetx=NothingEndSub2，用ADOConnection对象查询OptionExplicitPublicconnAsADODB.ConnectionSubMyquery()DimsConnect$,sql1$Setconn=CreateObject(adodb.connection)Sheets(sheet1).Cells.ClearContentssConnect=provider=microsoft.jet.oledb.4.0;extendedproperties=excel8.0;&_DataSource=&ThisWorkbook.Path&\&ThisWorkbook.Namesql1=select物料代码,物料描述,属性,单位from[物料代码表$]where属性='采购''表格名要用[$],条件部分用单引号''ThisWorkbook.Sheets(sheet1).Cells(2,1).CopyFromRecordsetconn.Execute(sql1)'copy后面紧接SQL查询执行语句WithSheets(sheet1).Range(A1)=物料代码'建立表头.Range(B1)=物料描述.Range(C1)=属性.Range(D1)=单位EndWith'conn.Close'可不用每次关闭数据源的连接EndSub3，用记录集执行单个查询OptionExplicitSubMyquery()DimrdAsADODB.RecordsetDimi%,j%,k%,sConnect$,sql1$,str$Setrd=NewADODB.Recordsetstr=外协Sheets(sheet1).Cells.ClearContentssConnect=provider=microsoft.jet.oledb.4.0;extendedproperties=excel8.0;&_DataSource=&ThisWorkbook.Path&\&ThisWorkbook.Name'conn.OpensConnect'打开数据源sql1=select物料代码,物料描述,属性,单位from[物料代码表$]where属性='采购''表格名要用[$],条件部分用单引号''rd.Opensql1,sConnect,adOpenForwardOnly,adLockReadOnlyThisWorkbook.Sheets(sheet1).Cells(2,1).CopyFromRecordsetrdWithSheets(sheet1).Range(A1)=物料代码'建立表头.Range(B1)=物料描述.Range(C1)=属性.Range(D1)=单位EndWithrd.Close'关闭记录集Setrd=Nothing'关闭EndSub4，引用一列，如A列‘引用单列、单行、单个单元格.xls'引用一列，如A列Subonecolumn()DimSql$SetConn=CreateObject(Adodb.Connection)Conn.Openprovider=microsoft.jet.oledb.4.0;extendedproperties='excel8.0;hdr=no';datasource=&ThisWorkbook.Path&\1.xlsSql=selectf1from[sheet1$]Cells.Clear[a1].CopyFromRecordsetConn.Execute(Sql)Conn.CloseSetConn=NothingEndSubSubdgzbhz()'2008/12/2‘=4912&pid=82252&page=1&extra=page%3D1#pid82252‘Book12021.xls‘由于分表的第2列表头是“金额”，不用它，改为“一中”，所以要用hdr=no无标题，拷贝时把第一行表头归零，所以最后要加表头。DimSql$SetConn=CreateObject(Adodb.Connection)[b2:d4]=arr=Array(一中,二中,三中)Fori=0ToUBound(arr)Conn.Openprovider=microsoft.jet.oledb.4.0;extendedproperties='excel8.0;hdr=no';datasource=&ThisWorkbook.Path&\&arr(i)&.xlsSql=selectf2from[sheet1$]Cells(1,i+2).CopyFromRecordsetConn.Execute(Sql)Conn.CloseNextiSetConn=Nothing[b1:d1]=arrEndSub‘test1203.xlsEH‘有标题不用hdr=no，列名用编码文字，可往下连续取数据。PrivateFunctioncnn()AsObjectSetcnn=CreateObject(ADODB.Connection)cnn.OpenProvider=Microsoft.Jet.Oledb.4.0;ExtendedProperties='Excel8.0;HDR=no';DataSource=&ThisWorkbook.FullNameEndFunctionSubonecolumn()DimSql$,Sht1AsWorksheet,ShtAsWorksheetDimnSetSht1=Sheets(汇总)Sht1.Activate‘SetConn=CreateObject(Adodb.Connection)‘Conn.Openprovider=microsoft.jet.oledb.4.0;extendedproperties='excel8.0';datasource=&ThisWorkbook.FullNameForEachShtInSheetsIfSht.Name汇总ThenSql=select编码from[&Sht.Name&$]n=[b65536].End(xlUp).Row+1Sht1.Cells(n,2).CopyFromRecordsetCnn.Execute(Sql)EndIfNextShtCnn.CloseSetCnn=NothingEndSub5，引用一行,如第1行'引用一Subonerow()DimSql$SetConn=CreateObject(Adodb.Connection)Conn.Openprovider=microsoft.jet.oledb.4.0;extendedproperties='excel8.0;hdr=no';datasource=&ThisWorkbook.Path&\1.xlsSql=select*from[sheet1$a1:iv1]Cells.Clear[a1].CopyFromRecordsetConn.Execute(Sql)Conn.CloseSetConn=NothingEndSub6，引用一个单元格，如k1单元格‘2013-3-14‘()DimmyPath$,mvvar,i&,myName$,Myr&Sheet1.Activate[a4:h500].ClearContentsSetConn=CreateObject(Adodb.Connection)myPath=ThisWorkbook.Path&\myName=ThisWorkbook.Namemvvar=FileList(myPath)IfTypeName(mvvar)BooleanThenFori=LBound(mvvar)ToUBound(mvvar)Ifmvvar(i)myNameThenConn.Openprovider=Microsoft.ACE.OLEDB.12.0;ExtendedProperties='Excel12.0;hdr=no';datasource=&ThisWorkbook.Path&\&mvvar(i)Sql=select*from[sheet1$h6:h6]Myr=[a65536].End(xlUp).Row+1IfMyr4ThenMyr=4Cells(Myr,3).CopyFromRecordsetConn.Execute(Sql)Cells(Myr,1)=Myr-3Cells(Myr,2)=Left(mvvar(i),Len(mvvar(i))-4)Sql=select*from[sheet1$c14:c14]Cells(Myr,4).CopyFromRecordsetConn.Execute(Sql)Sql=select*from[sheet1$c15:c15]Cells(Myr,5).CopyFromRecordsetConn.Execute(Sql)Sql=select*from[sheet1$c16:c16]Cells(Myr,6).CopyFromRecordsetConn.Execute(Sql)Conn.CloseEndIfNextElseMsgBox没有找到文件。EndIfMyr=Myr+1Cells(Myr,2)=合计Cells(Myr,3).Formula==sum(r4c:r[-1]c)Cells(Myr,3).AutoFillCells(Myr,3).Resize(1,5)EndSubFunctionFileList(fldr,OptionalfltrAsString=*.xls)AsVariantDimsTempAsString,sHldrAsStringIfRight$(fldr,1)\Thenfldr=fldr&\sTemp=Dir(fldr&fltr)IfsTemp=ThenFileList=FalseExitFunctionEndIfDosHldr=DirIfsHldr=ThenExitDosTemp=sTemp&|&sHldrLoopFileList=Split(sTemp,|)EndFunction'引用一个单元格，如k1单元格Subonecell()DimSql$SetConn=CreateObject(Adodb.Connection)Conn.Openprovider=microsoft.jet.oledb.4.0;extendedproperties='