18，纯文本查询（字段名用变量）
‘文本字段在A2单元格，查询文本在B2单元格 Sub 纯文本查询() Dim sh As String
Dim sql$, conn As New ADODB.Connection Dim Zdm$, czz$
Const nm = \出仓总查询\ '查询需操作的文件夹 Application.ScreenUpdating = False Zdm = [a2]: czz = Trim([b2])
Range(\
sh = Dir(ThisWorkbook.Path & \出仓数据库\\*.xls\ '数据库文件夹路径 While Not Len(sh) = 0
aa = Left(sh, Len(sh) - 4)
conn.Open \properties=excel 8.0;data source=\出仓数据库\\\
sql = \ \ [a65536].End(xlUp).Offset(1).CopyFromRecordset conn.Execute(sql) conn.Close sh = Dir() Wend
Application.ScreenUpdating = True End Sub
19，两表查询
‘EP Book0422.xls Sub sxhz0422()
Dim Sht2 As Worksheet, Sht3 As Worksheet Dim conn As ADODB.Connection
Dim Sql As String, sql1$, Myr1&, Myr2& Set Sht2 = Worksheets(\ Set Sht3 = Worksheets(\ Sht2.Activate
Myr1 = [a65536].End(xlUp).Row
Set conn = CreateObject(\
conn.Open \ThisWorkbook.FullName
Sql = \ ‘B记录在左，A记录在右，并列显示
‘Sql = \ ‘A记录在左，B记录在右，并列显示
‘Sql = \ left join [Sheet3$] as B on A.txno=B.txno \ ‘在A记录右边，并列显示B相同txno的记录
Sht2.[a65536].End(xlUp).Offset(1, 0).CopyFromRecordset conn.Execute(Sql) Myr2 = [a65536].End(xlUp).Row
Range(Cells(Myr1 + 1, 5), Cells(Myr2, 8)).ClearContents [a1].Select conn.Close
Set conn = Nothing End Sub
20，工资汇总（表格名变量、查询值变量Like）
‘EH help.xls Sub sxhz0422()
Dim Sht2 As Worksheet, Sht3 As Worksheet Dim conn As ADODB.Connection
Dim Sql As String, sql1$, Myr1&, Myr2& Set Sht2 = Worksheets(\生成月工资\ Sht2.Activate
Range(\ cj = Left([d1], 2) '车间 yf = [b1] '月份
Set Sht3 = Worksheets(cj)
Myr1 = [a65536].End(xlUp).Row
Set conn = CreateObject(\
conn.Open \ThisWorkbook.FullName
Sql = \操作员,sum(本日工资),sum(废品损失),sum(设备工作时间) from [\\日期 like '\操作员 \
Sht2.[a3].CopyFromRecordset conn.Execute(Sql) Myr2 = [a65536].End(xlUp).Row [a1].Select conn.Close
Set conn = Nothing End Sub
21，查询（f6,f7）
‘订单生成系统0427.xls
‘http://www.excelpx.com/dispbbs.asp?boardID=5&ID=50456&page=1 Private Sub Worksheet_Activate() On Error Resume Next
Dim x As Object, yy As Object, sql As String
Set x = CreateObject(\
x.Open \Properties='Excel 8.0;hdr=no;';Data Source=\
sql = \f6,f2,f3,f4,f7,f13,f17/2,f24-f25,(f24-f25)\\(f17/60),f17/60*75-f24,round(((f17-f24)/f7)/5,)*5 from [原始数据$] where (f24-f25)'C3'or f13 is null) order by (f24-f25)/(f17/60)\
Set yy = x.Execute(sql) Range(\
Range(\编号\品名\规格\产地\件装\属性\月销售\库存\\周转\计划\件数\实际\
[a2].CopyFromRecordset yy Set yy = Nothing Set x = Nothing End Sub
注：SQL语句中使用f4,f6的话，前面Properties='Excel 8.0;hdr=no’中要加hdr=no。
22，SQL不包含很多内容问题
‘http://club.excelhome.net/dispbbs.asp?boardID=2&ID=319199&page=1&px=0 1、\
join(application.transpose(worksheets(\
2、select * from [sheet2$] where ff not in(select ff from [sheet1$a1:a10])
23，在记录最后新增一条记录（RST.AddNew）
‘精英在线 2008-12-09
Private Sub CommandButton1_Click() '新增记录
Dim ArrValues(0 To 13) Dim ArrFields
ArrFields = Array(\乡镇名称\行政村名\路线编码\路线名称\起点名称\终点名称\\里程\路面类型\路面宽度\行政等级\技术等级\建设计划\计划年限\建设情况\
Set cnn = CreateObject(\
Set rst = CreateObject(\
Stpath = ThisWorkbook.Path & Application.PathSeparator & \农村公路数据库.mdb\ cnn.Provider = \
cnn.Open \ Strsql = \公路信息 where 路线编码='\rst.Open Strsql, cnn, adopendynamic, adlockoptimistic For x = 0 To 13
ArrValues(x) = Me.Controls(\Next x
rst.addnew ArrFields, ArrValues End Sub
24，不打开的多工作簿汇总（FileSearch）
‘http://club.excelhome.net/viewthread.php?tid=376533&highlight=?à1¤×÷2???×ü
Sub pldrwb1203() '汇总.xls
Dim myFs As FileSearch, Sht1 As Worksheet, Sht As Worksheet Dim myPath As String, Filename$
Dim i As Long, n As Long,aa,nm$,na%
Dim conn As Object, yy As Object, sql As String Set Sht1 = ActiveSheet Sht1.[a2:c1000] = \
Set conn = CreateObject(\ Set myFs = Application.FileSearch myPath = ThisWorkbook.Path With myFs
.NewSearch
.LookIn = myPath
.FileType = msoFileTypeNoteItem .Filename = \
If .Execute(SortBy:=msoSortByFileName) > 0 Then n = .FoundFiles.Count
ReDim myfile(1 To n) As String For i = 1 To n
myfile(i) = .FoundFiles(i) Filename = myfile(i)
aa = InStrRev(Filename, \
nm = Right(Filename, Len(Filename) - aa) '带后缀的Excel文件名 If nm = ThisWorkbook.Name Then GoTo 100
conn.Open \properties='excel 8.0';data source=\
sql = \A.单位名称,B.单位人员数量,C.单位领导数量 from [表一$] as A,[表二$] as B,[表三$] as C\
na = Sht1.[a65536].End(xlUp).Row + 1
Sht1.Cells(na, 1).CopyFromRecordset conn.Execute(sql) conn.Close 100: Next i
Set conn = Nothing
Else
MsgBox \该文件夹里没有任何文件\ End If End With [a1].Select
Set myFs = Nothing End Sub
精英在线
‘http://www.exceljy.com/viewthread.php?tid=5381&page=1#pid91432 Sub pldrwb1213() '汇总表.xls
Dim myFs As FileSearch, Sht1 As Worksheet, Sht As Worksheet Dim myPath As String, Filename$
Dim i As Long, n As Long, aa, nm$, na%
Dim conn As Object, yy As Object, sql As String Set Sht1 = ActiveSheet Sht1.[g7:ac25] = \
Set conn = CreateObject(\ Set myFs = Application.FileSearch myPath = ThisWorkbook.Path With myFs
.NewSearch
.LookIn = myPath
.FileType = msoFileTypeNoteItem .Filename = \
If .Execute(SortBy:=msoSortByFileName) > 0 Then n = .FoundFiles.Count
ReDim myfile(1 To n) As String For i = 1 To n
myfile(i) = .FoundFiles(i) Filename = myfile(i)
aa = InStrRev(Filename, \
nm = Right(Filename, Len(Filename) - aa) '带后缀的Excel文件名 If nm = ThisWorkbook.Name Then GoTo 100
conn.Open \properties='excel 8.0;hdr=no';data source=\
nm = Left(nm, Len(nm) - 4)
sql = \ nm = Left(nm, Len(nm) - 3)
Set r1 = Sht1.Range(\ na = r1.Row
Sht1.Cells(na, 7).CopyFromRecordset conn.Execute(sql) conn.Close