Set oFso = CreateObject("Scripting.FileSystemObject")
dim path(30)
dim name(30)
'说明书表头有15列：补丁号 问题序号 问题单号/安全问题编号 icare单号 问题现象 问题影响 重现条件 问题原因 解决方案 修改影响 严重级别 关键字 操作注意事项 补丁生效操作类型 业务恢复操作类型
'结果表头有17列：文档名 大包版本 补丁号 问题序号 问题单号/安全问题编号 icare单号 问题现象 问题影响 重现条件 问题原因 解决方案 修改影响 严重级别 关键字 操作注意事项 补丁生效操作类型 业务恢复操作类型
dim searchRes(30,30)
searchRes(0,0) = "文档名"
searchRes(0,1) = "大包版本"
searchRes(0,2) = "补丁号"
searchRes(0,3) = "问题序号"
searchRes(0,4) = "问题单号/安全问题编号"
searchRes(0,5) = "icare单号"
searchRes(0,6) = "问题现象"
searchRes(0,7) = "问题影响"
searchRes(0,8) = "重现条件"
searchRes(0,9) = "问题原因"
searchRes(0,10) = "解决方案"
searchRes(0,11) = "修改影响"
searchRes(0,12) = "严重级别"
searchRes(0,13) = "关键字"
searchRes(0,14) = "操作注意事项"
searchRes(0,15) = "补丁生效操作类型"
searchRes(0,16) = "业务恢复操作类型"
dim dir
dim dts
'搜索到的excel文件数
dim i
i = 0
dim resultNum
resultNum = 0
dir = Inputbox("请输入说明书所在路径：","说明书路径")
dts = Inputbox("请输入所搜索的DTS单号，以DTS+单号的形式输入：（如DTS2019012206086）","DTS单号")
'msgbox "点击确定开始搜索，需要一定的时间"
TreeIt(dir) '获得了路径和表格名称
'msgbox "搜索到路径下有" & i & "个Excel文档"
SearchDTS(path)
'msgbox "OK"
OutputRes(searchRes)
msgbox "搜索到路径下有" & i & "个Excel文档,匹配到" & resultNum & "个结果"
Function TreeIt(sPath)
on error resume next
Set oFso = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFso.GetFolder(sPath)
Set oSubFolders = oFolder.Subfolders
Set oFiles = oFolder.Files
For Each oFile In oFiles
If Right(oFile.Path,3) ="xls" or Right(oFile.Path,4) ="xlsx" Then
path(i) = oFile.path
name(i) = oFile.name
i = i+1
End If
Next
For Each oSubFolder In oSubFolders
TreeIt(oSubFolder.Path)
Next
End Function
Function SearchDTS(sPath)
dim searchResRow,searchResCol
searchResRow = 1
searchResCol = 1
Set oExcel = CreateObject("Excel.Application") '创建Excel应用程序对象
'xlApp.Visible=True
for j = 0 to i-1
Set oWb=oExcel.Workbooks.Open(sPath(j))
'显示打开的Excel工作簿
'oExcel.visible=true
'******************************************
'遍历工作簿的所有工作表
'******************************************
for t = 1 to oWb.sheets.count
set oSheet=oWb.Sheets(t)
'选中并激活工作表
oSheet.Activate
'获取当前Excel表格总共多少行
'Msgbox oSheet.name
RowsCount=oSheet.UsedRange.Rows.Count
for m = 1 to RowsCount
value = oSheet.range("C"&m).Value
if value = dts then
Row = m '获取到数据在第m行
resultNum = resultNum + 1
searchRes(searchResRow,0) = name(j)
searchRes(searchResRow,1) = oSheet.name
'msgbox s
for searchResCol = 2 to 16
searchRes(searchResRow,searchResCol) = oSheet.cells(Row,searchResCol-1).Value
'msgbox oSheet.cells(Row,searchResCol).Value
'msgbox searchRes(searchResRow,searchRowCol)
'msgbox searchRes(searchResRow,searchResCol)
next
searchResRow = searchResRow + 1
exit for
end if
next
next
oWb.close
Next
oExcel.Quit
End Function
Function OutputRes(myarray)
Set oExcel = CreateObject( "Excel.Application" )
oExcel.Visible = True
oExcel.WorkBooks.Add
oExcel.WorkSheets(1).Activate
Set oSheet=oExcel.Workbooks(1).Worksheets(1)
for p = 1 to resultNum+1
for q = 1 to 30
oSheet.cells(p,q).Value = searchRes(p-1,q-1)
next
oSheet.Columns("A:Q").AutoFit()
oSheet.Rows("1:30").Rows.AutoFit()
next
End Function