yu2n

Option Explicit

RunAsAdmin

Msgbox CreateObject("WScript.Shell").CurrentDirectory

' 以管理员身份运行 By Yu2n
Sub RunAsAdmin()
	Dim oItems, vItem, sVer, nVer, vArg, sArgs, sCurDir
	Set oItems = GetObject("winmgmts:").InstancesOf("Win32_OperatingSystem")
	For Each vItem In oItems
		sVer = vItem.Version
	Next
	Set oItems = Nothing
	nVer = Clng(Split(sVer, ".")(0) & Split(sVer, ".")(1))
	If nVer >= 60 Then
		If Not WScript.Arguments.Named.Exists("RunAsAdmin") Then
			For Each vArg In WScript.Arguments
				sArgs = sArgs & " """ & vArg & """"
			Next
			sArgs = sArgs & " /RunAsAdmin:True"
			CreateObject("Shell.Application").ShellExecute "WScript.exe", _
				"""" & WScript.ScriptFullName & """" & sArgs, "", "runas", 1
			WScript.Quit(0)
		Else
			sCurDir = Left(WScript.ScriptFullName, InStrRev(WScript.ScriptFullName, "\") -1)
			CreateObject("WScript.Shell").CurrentDirectory = sCurDir
		End If
	End If
End Sub
复制代码

yu2n

回复 5# doswork

Option Explicit

'以管理员身份运行
RunAsAdmin

'待删除文件夹
Const DEL_DIR = "C:\TEST"

Dim wso, cmdLine
Set wso = CreateObject("WScript.Shell")

'命令：移除属性，删除文件夹/子文件/子文件夹
cmdLine = "cmd /c " & _
	"attrib -R -A -S -H /S /D """ & DEL_DIR & """ & " & _
	"if exist """ & DEL_DIR & """ rd /s /q """ & DEL_DIR & """"

'	等于执行CMD命令：
'	attrib -R -A -S -H /S /D "C:\test"
'	if exist "C:\test" rd /s /q "C:\test"

'执行命令，回报结果
If wso.Run(cmdLine, 0, True) = 0 Then
	Msgbox DEL_DIR & " 删除成功!", vbInformation, WScript.ScriptFullName
Else
	Msgbox DEL_DIR & " 删除失败!", vbCritical, WScript.ScriptFullName
End If



' 以管理员身份运行 By Yu2n
Sub RunAsAdmin()
	Dim oItems, vItem, sVer, nVer, vArg, sArgs, sCurDir
	Set oItems = GetObject("winmgmts:").InstancesOf("Win32_OperatingSystem")
	For Each vItem In oItems
		sVer = vItem.Version
	Next
	Set oItems = Nothing
	nVer = Clng(Split(sVer, ".")(0) & Split(sVer, ".")(1))
	If nVer >= 60 Then
		If Not WScript.Arguments.Named.Exists("RunAsAdmin") Then
			For Each vArg In WScript.Arguments
				sArgs = sArgs & " """ & vArg & """"
			Next
			sArgs = sArgs & " /RunAsAdmin:True"
			CreateObject("Shell.Application").ShellExecute "WScript.exe", _
				"""" & WScript.ScriptFullName & """" & sArgs, "", "runas", 1
			WScript.Quit(0)
		Else
			sCurDir = Left(WScript.ScriptFullName, InStrRev(WScript.ScriptFullName, "\") -1)
			CreateObject("WScript.Shell").CurrentDirectory = sCurDir
		End If
	End If
End Sub
复制代码

yu2n

Option Explicit

Main
Sub Main()

	'以管理员身份运行
	RunAsAdmin

	'待删除文件夹
	Const DEL_DIR = "C:\TEST"

	Dim wso, cmdLine
	Set wso = CreateObject("WScript.Shell")

	'命令：移除属性，删除文件夹/子文件/子文件夹
	cmdLine = "cmd /c " & _
		"attrib -R -A -S -H /S /D """ & DEL_DIR & """ & " & _
		"if exist """ & DEL_DIR & """ rd /s /q """ & DEL_DIR & """"
	Call wso.Run(cmdLine, 0, True)

	'命令：创建文件夹
	cmdLine = "cmd /c " & _
		"if not exist """ & DEL_DIR & """ md """ & DEL_DIR & """"
	Call wso.Run(cmdLine, 0, True)
	
	'提示完成
	Msgbox "完成！", vbInformation, WScript.ScriptFullName
	
End Sub

' 以管理员身份运行 By Yu2n
Sub RunAsAdmin()
	Dim oItems, vItem, sVer, nVer, vArg, sArgs, sCurDir
	Set oItems = GetObject("winmgmts:").InstancesOf("Win32_OperatingSystem")
	For Each vItem In oItems
		sVer = vItem.Version
	Next
	Set oItems = Nothing
	nVer = Clng(Split(sVer, ".")(0) & Split(sVer, ".")(1))
	If nVer >= 60 Then
		If Not WScript.Arguments.Named.Exists("RunAsAdmin") Then
			For Each vArg In WScript.Arguments
				sArgs = sArgs & " """ & vArg & """"
			Next
			sArgs = sArgs & " /RunAsAdmin:True"
			CreateObject("Shell.Application").ShellExecute "WScript.exe", _
				"""" & WScript.ScriptFullName & """" & sArgs, "", "runas", 1
			WScript.Quit(0)
		Else
			sCurDir = Left(WScript.ScriptFullName, InStrRev(WScript.ScriptFullName, "\") -1)
			CreateObject("WScript.Shell").CurrentDirectory = sCurDir
		End If
	End If
End Sub
复制代码

注意：无法删除使用中的文件/文件夹。