Const PATH = "."		'指定文件目錄
Const FLAG = ";"		'多個拓展名使用英文分號(;)分隔
Const EXS = "bmp;jpg"	'排除文件拓展名

Dim oItems, oFile, nCount : nCount = 0
Set fso = CreateObject("Scripting.FileSystemObject")
Set oItems = fso.GetFolder(PATH)
For Each oFile In oItems.Files
	If InStr(1, FLAG & EXS & FLAG, FLAG & fso.GetExtensionName(oFile) & FLAG, vbTextCompare) <= 0 Then
		nCount = nCount + 1
	End If
Next
If nCount > 0 Then
	If Msgbox("目錄位置：" & oItems.Path & vbCrLf & vbCrLf & _
			"掃尋完成，共匹配 " & nCount & " 個文件。是否刪除？", _
			vbQuestion+vbYesNoCancel+vbDefaultButton2, "提示") = vbYes Then
		For Each oFile In oItems.Files
			If InStr(1, FLAG & EXS & FLAG, FLAG & fso.GetExtensionName(oFile) & FLAG, vbTextCompare) <= 0 Then
				fso.DeleteFile oFile.Path, True
			End If
		Next
	End If
Else
	Msgbox "目錄位置：" & oItems.Path & vbCrLf & vbCrLf & "掃尋完成，沒有發現匹配文件。", vbInformation, "提示"
End If
复制代码