Dim list, flist, listArr, listItem, oShell, oItem, jobFolder, objFsoDim oDir, oFolder, oFolders, oFile, oFiles, a, path list = "" flist = "" Set oShell = CreateObject("Shell.Application") Set oItem = oShell.BrowseForFolder(0, "Scegli la cartella di lavoro:", 0, "") If oItem Is Nothing Then Wscript.Quit End If jobFolder = oItem.Self.Path & "" Set oShell = Nothing Set oItem = Nothing Dim vIns : vIns = InputBox ("Inserisci cosa cercare:", "Ricerca", "") If vIns = "" Then Wscript.Quit End If list = "?" & jobFolder Do Until (InStr(1, list, "?") = 0) listArr = Split(list, "^") For Each listItem In listArr a = Mid(listItem, 1, 1) path = Mid(listItem, 2) If a = "?" Then Set objFso = CreateObject("Scripting.FileSystemObject") Set oDir = objFso.GetFolder(path) Set oFolders = oDir.SubFolders For Each oFolder In oFolders list = list & "^" & "?" & path & oFolder.Name & "" Next Set objFso = Nothing Set oDir = Nothing Set oFolders = Nothing list = Replace(list, "?" & path, path, 1, 1) End If Next Loop listArr = Split(list, "^") For Each path In listArr Set objFso = CreateObject("Scripting.FileSystemObject") Set oDir = objFso.GetFolder(path) Set oFiles = oDir.Files For Each oFile In oFiles flist = flist & "^" & path & oFile.Name Next Set objFso = Nothing Set oDir = Nothing Set oFiles = Nothing Next Dim filesys, filetxt, fcontent, s sresult = "" listArr = Split(flist, "^") For Each path In listArr If path <> "" Then Set filesys = CreateObject("Scripting.FileSystemObject") Set filetxt = filesys.OpenTextFile(path, 1, True) fcontent = filetxt.ReadAll s = InStr(1, fcontent, vIns) If s > 0 Then sresult = sresult & "#" & s & Replace(path, jobFolder, ".") & vbCrLf End If filetxt.Close Set filesys = Nothing Set filetxt = Nothing End If Next If sresult = "" Then MsgBox "Nessun risultato trovato", 0, ":-(" Else MsgBox sresult End If
VBScript Cercare stringa all'interno di un gruppo di files
Dim list, flist, listArr, listItem, oShell, oItem, jobFolder, objFsoDim oDir, oFolder, oFolders, oFile, oFiles, a, path list = "" flist = "" Set oShell = CreateObject("Shell.Application") Set oItem = oShell.BrowseForFolder(0, "Scegli la cartella di lavoro:", 0, "") If oItem Is Nothing Then Wscript.Quit End If jobFolder = oItem.Self.Path & "" Set oShell = Nothing Set oItem = Nothing Dim vIns : vIns = InputBox ("Inserisci cosa cercare:", "Ricerca", "") If vIns = "" Then Wscript.Quit End If list = "?" & jobFolder Do Until (InStr(1, list, "?") = 0) listArr = Split(list, "^") For Each listItem In listArr a = Mid(listItem, 1, 1) path = Mid(listItem, 2) If a = "?" Then Set objFso = CreateObject("Scripting.FileSystemObject") Set oDir = objFso.GetFolder(path) Set oFolders = oDir.SubFolders For Each oFolder In oFolders list = list & "^" & "?" & path & oFolder.Name & "" Next Set objFso = Nothing Set oDir = Nothing Set oFolders = Nothing list = Replace(list, "?" & path, path, 1, 1) End If Next Loop listArr = Split(list, "^") For Each path In listArr Set objFso = CreateObject("Scripting.FileSystemObject") Set oDir = objFso.GetFolder(path) Set oFiles = oDir.Files For Each oFile In oFiles flist = flist & "^" & path & oFile.Name Next Set objFso = Nothing Set oDir = Nothing Set oFiles = Nothing Next Dim filesys, filetxt, fcontent, s sresult = "" listArr = Split(flist, "^") For Each path In listArr If path <> "" Then Set filesys = CreateObject("Scripting.FileSystemObject") Set filetxt = filesys.OpenTextFile(path, 1, True) fcontent = filetxt.ReadAll s = InStr(1, fcontent, vIns) If s > 0 Then sresult = sresult & "#" & s & Replace(path, jobFolder, ".") & vbCrLf End If filetxt.Close Set filesys = Nothing Set filetxt = Nothing End If Next If sresult = "" Then MsgBox "Nessun risultato trovato", 0, ":-(" Else MsgBox sresult End If