求助,关于删除电脑所有盘同名应用程序代码!
在网上找到的代码,运行后发现只能删除我的文档和桌面指定的文件,而放在D.E.F.G盘里的同名文件都不能删除,请问怎么改一下才能删除,代码如下。程序代码:
Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long Private i As Integer Private MyFile As String Private Sub Command1_Click() Dim m, d$ On Error Resume Next d = String(256, Chr(0)) GetLogicalDriveStrings Len(d), d i = 0 MyFile = "" For m = 1 To 100 '搜索整个磁盘 If Left$(d, InStr(1, d, Chr$(0))) = Chr$(0) Then Exit For Text1.Text = "正在搜索:" & Left$(d, InStr(1, d, Chr$(0)) - 1) OutFile Left$(d, InStr(1, d, Chr$(0)) - 1), "\b.exe" '不加斜杠是模糊查找 d = Right$(d, Len(d) - InStr(1, d, Chr$(0))) Next Text1.Text = "搜索结果:" & vbCrLf & MyFile '文本框设为多行显示被找到的文件清单 MsgBox "一共找到并删除:" & i & " 个文件" End Sub Private Sub OutFile(ByVal MyFolder As String, ByVal MyFileName As String) Dim fs, F, f1, S, sf, f2, mf Dim L As Integer Set fs = CreateObject("Scripting.FileSystemObject") Set F = fs.GetFolder(MyFolder) Set sf = F.SubFolders For Each f1 In sf OutFile f1, MyFileName DoEvents Next L = Len(MyFileName) Set mf = F.Files For Each f2 In mf If Right(f2, L) = MyFileName Then Kill MyFile & f2 '删除文件 i = i + 1 MyFile = MyFile & f2 & vbCrLf End If DoEvents Next End Sub