100: Next i
Set conn = Nothing Else
MsgBox \该文件夹里没有任何文件\ End If End With [a1].Select
Set myFs = Nothing End Sub
25，Listview模糊查询（ADO+SQL）
‘http://club.excelhome.net/thread-457530-1-1.html ‘SQL_Sample.xls
‘Books3(Version 1).xls
Private Sub UserForm_Initialize() Dim ltm As ListItem On Error Resume Next With Me.ListView1
.ColumnHeaders.Add , , \终端客户\ .ColumnHeaders.Add , , \ .ColumnHeaders.Add , , \ .View = 3 End With End Sub
Private Sub TextBox1_Change() Dim mSQL$ Dim Conn, RST Dim y, i
On Error Resume Next
If TextBox1.Text <> \终端客户,TYPE,T from E_FH where 终端客户 like '%\ ‘此处用了工作表命名应用的特殊用法
Set RST = CreateObject(\ Set Conn = CreateObject(\
Conn.Open \properties=excel 8.0;data source=\& ThisWorkbook.FullName
RST.Open mSQL, Conn,1,1 ListView1.ListItems.Clear For i = 1 To RST.RecordCount y = y + 1
Me.ListView1.ListItems.Add , , RST(\终端客户\
Me.ListView1.ListItems(y).SubItems(1) = RST(\ Me.ListView1.ListItems(y).SubItems(2) = RST(\
RST.MoveNext Next
RST.Close: Conn.Close
Set RST = Nothing: Set Conn = Nothing End Sub
Private Sub ListView1_Click() On Error Resume Next
TextBox2.Text = ListView1.ListItems(ListView1.SelectedItem.Index) End Sub
Private Sub CommandButton1_Click() Unload Me End Sub
问题在http://club.excelhome.net/thread-269780-1-1.html
‘by:zhaogang1960 2010-3-19
‘http://club.excelhome.net/viewthread.php?tid=549165&page=1#pid3650329 ‘模糊查询_listview.xls
'Microsoft ActiveX Data Objects 2.x Library Dim cnn As ADODB.Connection Dim rs As ADODB.Recordset
Private Sub CommandButton1_Click() cnn.Close
Set rs = Nothing Set cnn = Nothing Unload Me End Sub
Private Sub ListView1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader) On Error GoTo myerr
ListView1.SortKey = ColumnHeader.Index - 1 If ListView1.SortOrder = lvwDescending Then ListView1.SortOrder = lvwAscending Else
ListView1.SortOrder = lvwDescending End If
ListView1.Sorted = True myerr:
Exit Sub End Sub
Private Sub TextBox1_Change() Dim SQL$, temp$, i&, j& temp = TextBox1.Text
If temp = \
SQL = \ Else
SQL = \商品代码 like '%\商品名称 like '%\分类 like '%\
End If
Set rs = New ADODB.Recordset
rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic On Error Resume Next With ListView1
.ListItems.Clear
For i = 1 To rs.RecordCount
.ListItems.Add , , rs.Fields(0).Value For j = 1 To rs.Fields.Count - 1
.ListItems(i).SubItems(j) = rs.Fields(j).Value Next j
total = total + rs.Fields(3).Value rs.MoveNext Next i End With rs.MoveFirst
Label2.Caption = \共找到 \条记录\ Label3.Caption = \总计: \ TextBox1.SetFocus End Sub
Private Sub UserForm_Initialize()
Dim mydata$, SQL$, i&, j&, a, total As Double a = Array(8, 1.8, 15, 8)
mydata = ThisWorkbook.Path & \ Set cnn = New ADODB.Connection With cnn
.Provider = \ .Open mydata End With
SQL = \ Set rs = New ADODB.Recordset
rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic On Error Resume Next With ListView1
.ColumnHeaders.Clear .ListItems.Clear
.View = lvwReport ' listivew的显示格式为报表格式 .FullRowSelect = True ' 允许整行选中
.Gridlines = True ' 显示网格线 For i = 0 To rs.Fields.Count - 1
.ColumnHeaders.Add , , rs.Fields(i).Name, Width / a(i) Next i
Label2.Caption = \ Label2.Caption = \
For i = 1 To rs.RecordCount
.ListItems.Add , , rs.Fields(0).Value For j = 1 To rs.Fields.Count - 1
.ListItems(i).SubItems(j) = rs.Fields(j).Value Next j
total = total + rs.Fields(3).Value rs.MoveNext Next i End With rs.MoveFirst
Label2.Caption = \共找到 \条记录\ Label3.Caption = \总计: \ TextBox1.SetFocus End Sub
26，ADO+Do+Dir(by:lenghonhhai版主)
‘http://club.excelhome.net/viewthread.php?tid=500108&pid=3288623&page=1&extra=page=1
Private Sub CommandButton1_Click() Dim cn As Object, s$, s1$, x%
Set cn = CreateObject(\s = Dir(ThisWorkbook.Path & \x = 2
Do While s <> \If s <> \数据.xls\
cn.Open \source=\
s1 = \日期,供货商,批号,出库数量,库存数量,往来单位 from [第1页$b3:h65536]\
Range(\ x = Range(\ cn.Close
End If s = Dir Loop End Sub
27，不打开工作簿多表提取数据（ADODB）
‘程序.xls ‘2009-11-10
‘http://club.excelhome.net/viewthread.php?tid=500442&pid=3291071&page=1&extra=page=1#
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Row <> 4 Then Exit Sub Dim cn As Object, sql$, s, rst, clbh$, x If x < 5 Or x > 22 Then Exit Sub x = Target.Column
Application.EnableEvents = False
Set cn = CreateObject(\Set rst = CreateObject(\Range(Cells(5, x), Cells(100, x)) = \s = ThisWorkbook.Path & \目录.xls\cn.Open
\
properties=excel
8.0;data
source=\
sql = \目录$] where 定额编号='\rst.Open sql, cn, adOpenStatic ‘提取一行数据 Cells(5, x).Value = rst(\名称及说明\Cells(6, x).Value = rst(\合价\Cells(7, x).Value = rst(\人工\Cells(8, x).Value = rst(\材料\Cells(9, x).Value = rst(\机械\Cells(10, x).Value = rst(\管理费\Cells(11, x).Value = rst(\单位\rst.Close: cn.Close
s = ThisWorkbook.Path & \材料消耗库.xls\