apang

Do
    Input = InputBox("输入：")
    If IsEmpty(Input) Then WScript.Quit
Loop while Input = ""
 
Set oExcel = CreateObject("Excel.Application")
oExcel.Visible = false
oExcel.WorkBooks.Open("d:\test\db1.mdb")
oExcel.WorkSheets(1).Activate
row = oExcel.ActiveSheet.UsedRange.Rows.Count
 
For i = 2 to row
    flag = true
    For j = 1 to Len(Input)
        If InStr(oExcel.Cells(i,4), Mid(Input,j,1)) = 0 Then
            flag = false : Exit For
        End if
    Next
    If flag Then
        s = ""
        For j = 2 to 5
            s = s & oExcel.Cells(i,j) & vbTab
        Next
        MsgBox s
    End If
Next
If s = "" Then MsgBox "Not Found"
oExcel.ActiveWorkBook.Saved = true
oExcel.WorkBooks.Close
oExcel.QuitCOPY

apang

回复 3# DDDYJQ1


    我用的是ms-office2007，没有安装Access，测试顶楼附件没有问题

apang

回复 6# DDDYJQ1


    第8行的路径和文件名改成真实路径和文件名，第12行的2改成1