VBS腳本查找和刪除文件

Question

我正試圖在計算機上查找特定文件並將其刪除。

這是我的代碼：

Const DeleteReadOnly = True 

Set oFSO = CreateObject("Scripting.FileSystemObject") 
Set oWshShell = CreateObject("WScript.Shell") 
sDir = oWshShell.ExpandEnvironmentStrings("%temp%\dir.txt") 
sFileName = "\date.vbs" 

If oFSO.FileExists(sDir) Then oFSO.DeleteFile(sDir) 

For Each oDrive In oFSO.Drives 
if oDrive.DriveType = 2 Then Search oDrive.DriveLetter 
Next 

Set oFile = oFSO.OpenTextFile(sDir, 1) 
aNames = Split(oFile.ReadAll, VbCrLf) 
oFile.Close 
For Each sName In aNames 
If InStr(1, sName, sFileName, 1) > 0 Then WScript.Echo sName 
Next 

dim filesys 
Set filesys = CreateObject("Scripting.FileSystemObject") 
filesys.CreateTextFile "\date.vbs", True 
If filesys.FileExists("\date.vbs") Then 
filesys.DeleteFile "\date.vbs" 
Wscript.Echo("File deleted") 
End If 


Sub Search(sDrive) 
WScript.Echo "Scanning drive " & sDrive & ":" 
oWshShell.Run "cmd /c dir /s /b " & sDrive & ":\" & sName & " >>" & sDir, 0, True 
End Sub 

的代碼工作只有部分。當文件「date.vbs」位於根文件夾（C：\ date.vbs）中時，它將被刪除，但當它位於文件夾（C：\ backup \ date.vbs）中時，則不會被刪除。你知道我應該做哪些代碼更改，以便能夠刪除文件，即使它不在根目錄中但在計算機中的任何位置？

謝謝！ V.

更新：

該代碼現在非常有效。我只是有最後一個刪除文件的問題。我能夠將屬性從只讀更改爲正常，但仍然出現訪問被拒絕的錯誤。

這是我的代碼：

Const DeleteReadOnly = True 
Dim oFSO, oDrive, sFileName, ws, WshS, fso, usrProfile, oFolder, skypefolder 

Set oFSO = CreateObject("Scripting.FileSystemObject") 
sFileName = "Skype.exe" 

Set WshS = WScript.CreateObject("WScript.Shell") 
usrProfile = WshS.ExpandEnvironmentStrings("%UserProfile%") 
skypefolder = "C:\Program Files (x86)\Skype\" 

For Each oDrive In oFSO.Drives 
    If oDrive.DriveType = 2 Then Recurse oFSO.GetFolder(skypefolder) 
Next 

Sub Recurse(oFolder) 
    Set oFile = CreateObject("Scripting.FileSystemObject") 
    Dim oSubFolder, oFile 

    If IsAccessible(oFolder) Then 
    For Each oSubFolder In oFolder.SubFolders 
    Recurse oSubFolder 
    Next 
    WScript.Echo oFolder.Path 

    For Each oFile In oFolder.Files 
     If oFile.Name = sFileName And oFile.Attributes And 1 Then 
     oFile.Attributes = 0 
     oFile.Delete True 

     End If 
     Next 
    End If 
End Sub 

Function IsAccessible(oFolder) 
    On Error Resume Next 
    IsAccessible = oFolder.SubFolders.Count >= 0 
End Function 

感謝您的幫助！

我用來以ADMIN身份運行腳本的代碼。之後它開始顯示MessageBoxes。它在控制檯中運行之前。

If WScript.Arguments.Named.Exists("elevated") = False Then 

    CreateObject("Shell.Application").ShellExecute "wscript.exe", """" &  WScript.ScriptFullName & """ /elevated", "", "runas", 1 
    WScript.Quit 
Else 

    Set oShell = CreateObject("WScript.Shell") 
    oShell.CurrentDirectory =  CreateObject("Scripting.FileSystemObject").GetParentFolderName(WScript.ScriptFullName) 
    'WScript.Echo("Now running with elevated permissions") 

End If 

所以我相信這段代碼有問題。

Answer 1

你的方法太複雜了。使用簡單的遞歸函數：

Option Explicit 

Const DeleteReadOnly = True 
Dim oFSO, oDrive, sFileName 

Set oFSO = CreateObject("Scripting.FileSystemObject") 
sFileName = "date.vbs" 

For Each oDrive In oFSO.Drives 
    If oDrive.DriveType = 2 Then Recurse oDrive.RootFolder 
Next 

Sub Recurse(oFolder) 
    Dim oSubFolder, oFile 

    If IsAccessible(oFolder) Then 
    For Each oSubFolder In oFolder.SubFolders 
    Recurse oSubFolder 
    Next 

    For Each oFile In oFolder.Files 
     If oFile.Name = sFileName Then 
     'oFile.Delete ' or whatever 
     End If 
    Next 
    End If 
End Sub 

Function IsAccessible(oFolder) 
    On Error Resume Next 
    IsAccessible = oFolder.SubFolders.Count >= 0 
End Function 

爲了實現不區分大小寫的文件名比較，你可以使用

If StrComp(oFile.Name, sFileName, vbTextCompare) = 0 Then 

Answer 2

作爲一個練習：您還可以使用WMI服務來查找某些文件。你不必去通過所有文件夾，您剛纔查詢任何驅動器上的文件，在任何文件夾：

Function find_file(filename) 

    Dim objWMIService, colItems, objItem, strComputer 
    strComputer = "." 

    Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2") 
    Set colItems = objWMIService.ExecQuery("SELECT * FROM CIM_DataFile WHERE FileName='" & filename & "'",,48) 

    For Each objItem in colItems 
     msgbox "Found " & objItem.Name & " in " objItem.Path 
    Next 

End Function 

注：該函數返回其結果之前，它可以長時間。