搜素表腳本.vbs

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