[發問] 關機問題

spermbank

大家好:

     請問一下，我想用excel vba執行完程式後，自動關閉電腦。
     查了很久，不知道怎麼樣用vba程式來關機，所以請教一下大家，感謝。

Joforn

提醒：Exit_FORCE表示自動關閉後台運行中的程式，這樣就不會因為其它程式的原因導致關閉Windows失敗，但是如果使用了這個參數，一定要記得把自己的所有的檔案的存樓哦，否則，所有的沒有存檔的文件將丟失最新的修改！！如果不使用這個參數，那麼一般情況下可能都不會關閉計算機成功，因為後台一般會有很多程式會自己阻止關機指令。

Joforn

回復 1# spermbank
注意ExitWindows這個程式的調用參數，可以分別用以实现關閉電源、重新啟動Windows或是登出當前用戶。

1. #If VBA7 Then
   
2.   Private Declare PtrSafe Function ExitWindowsEx Lib "user32" (ByVal dwOptions As Long, ByVal dwReserved As Long) As Long
   
3.   Private Declare PtrSafe Function GetLastError Lib "KERNEL32" () As Long
   
4.   Private Declare PtrSafe Function GetCurrentProcess Lib "KERNEL32" () As Long
   
5.   Private Declare PtrSafe Function OpenProcessToken Lib "advapi32" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
   
6.   Private Declare PtrSafe Function LookupPrivilegeValue Lib "advapi32" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID) As Long
   
7.   Private Declare PtrSafe Function AdjustTokenPrivileges Lib "advapi32" (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long
   
8.   Private Declare PtrSafe Sub SetLastError Lib "KERNEL32" (ByVal dwErrCode As Long)
   
9.   Private Declare PtrSafe Function GetVersion Lib "KERNEL32" () As Long
   
10. #Else
    
11.   Private Declare Function ExitWindowsEx Lib "user32" (ByVal dwOptions As Long, ByVal dwReserved As Long) As Long
    
12.   Private Declare Function GetLastError Lib "KERNEL32" () As Long
    
13.   Private Declare Function GetCurrentProcess Lib "KERNEL32" () As Long
    
14.   Private Declare Function OpenProcessToken Lib "advapi32" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
    
15.   Private Declare Function LookupPrivilegeValue Lib "advapi32" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID) As Long
    
16.   Private Declare Function AdjustTokenPrivileges Lib "advapi32" (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long
    
17.   Private Declare Sub SetLastError Lib "KERNEL32" (ByVal dwErrCode As Long)
    
18.   Private Declare Function GetVersion Lib "KERNEL32" () As Long
    
19. #End If
    
20. 
    
21. Private Type LUID
    
22.   UsedPart As Long
    
23.   IgnoredForNowHigh32BitPart As Long
    
24. End Type
    
25. 
    
26. Private Type LUID_AND_ATTRIBUTES
    
27.   TheLuid As LUID
    
28.   Attributes As Long
    
29. End Type
    
30. 
    
31. Private Type TOKEN_PRIVILEGES
    
32.   PrivilegeCount As Long
    
33.   TheLuid As LUID
    
34.   Attributes As Long
    
35. End Type
    
36. 
    
37. Public Enum ExitMode
    
38.   Exit_LOGOFF = 0&
    
39.   Exit_SHUTDOWN = 1&
    
40.   Exit_REBOOT = 2&
    
41.   Exit_FORCE = 4&
    
42.   Exit_POWEROFF = 8&
    
43.   Exit_FORCEIFHUNG = &H10&
    
44.   Exit_RESTARTAPPS = &H40&
    
45. End Enum
    
46. 
    
47. Public Function ExitWindows(Optional ByVal ExitMode As ExitMode = Exit_SHUTDOWN Or Exit_FORCE) As Long
    
48. 
    
49. '********************************************************************
    
50. '* 這個程式用來關閉、重啟計算機或是登出當前用戶
    
51. '********************************************************************
    
52. 
    
53.   Const TOKEN_ADJUST_PRIVILEGES = &H20
    
54.   Const TOKEN_QUERY = &H8
    
55.   Const SE_PRIVILEGE_ENABLED = &H2
    
56.   
    
57.   Dim hdlProcessHandle  As Long
    
58.   Dim hdlTokenHandle    As Long
    
59.   Dim tmpLuid           As LUID
    
60.   Dim tkp               As TOKEN_PRIVILEGES
    
61.   Dim tkpNewButIgnored  As TOKEN_PRIVILEGES
    
62.   Dim lBufferNeeded     As Long
    
63.   Dim lngVersion        As Long
    
64.   
    
65.   On Error GoTo ErrorExit
    
66.   Err.Clear
    
67.   lngVersion = GetVersion()
    
68.   If ((lngVersion And &H80000000) = 0) Then
    
69.     SetLastError 0
    
70.     hdlProcessHandle = GetCurrentProcess()
    
71.     ExitWindows = GetLastError:    If ExitWindows Then Exit Function
    
72.     OpenProcessToken hdlProcessHandle, (TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY), hdlTokenHandle
    
73.     ExitWindows = GetLastError:    If ExitWindows Then Exit Function
    
74.     LookupPrivilegeValue "", "SeShutdownPrivilege", tmpLuid
    
75.     ExitWindows = GetLastError:    If ExitWindows Then Exit Function
    
76.     tkp.PrivilegeCount = 1
    
77.     tkp.TheLuid = tmpLuid
    
78.     tkp.Attributes = SE_PRIVILEGE_ENABLED
    
79.     AdjustTokenPrivileges hdlTokenHandle, False, tkp, Len(tkpNewButIgnored), tkpNewButIgnored, lBufferNeeded
    
80.     ExitWindows = GetLastError:    If ExitWindows Then Exit Function
    
81.   End If
    
82.   If ExitWindowsEx(ExitMode, &HFFFF) = 0 Then ExitWindows = GetLastError
    
83.   Exit Function
    
84. ErrorExit:
    
85.   ExitWindows = Err.Number
    
86. End Function
    
87. 
    
88. Sub PowerOff()
    
89.   ExitWindows Exit_POWEROFF Or Exit_FORCE
    
90. End Sub

複製代碼

上一樓回復不知為何被論壇吃掉了一半的代碼……

jackyq

shell  "shutdown .........."

win7 不知道有沒有 shutdown.exe

http://idaiwan.pixnet.net/blog/post/27604073-%E4%BD%BF%E7%94%A8-shutdown.exe-%E5%AF%A6%E7%8F%BE-windows-%E4%B8%80%E9%8D%B5%E9%87%8D%E6%96%B0%E9%96%8B%E6%A9%9F%E3%80%81%E9%97%9C

Joforn

注意ExitWindows的调用参数，可以分别实现关机，重新啟動以及登出當前用戶[code]Option Explicit
'这个是关机控制模块
#If VBA7 Then
  Private Declare PtrSafe Function ExitWindowsEx Lib "user32" (ByVal dwOptions As Long, ByVal dwReserved As Long) As Long
  Private Declare PtrSafe Function GetLastError Lib "KERNEL32" () As Long
  Private Declare PtrSafe Function GetCurrentProcess Lib "KERNEL32" () As Long
  Private Declare PtrSafe Function OpenProcessToken Lib "advapi32" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
  Private Declare PtrSafe Function LookupPrivilegeValue Lib "advapi32" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID) As Long
  Private Declare PtrSafe Function AdjustTokenPrivileges Lib "advapi32" (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long
  Private Declare PtrSafe Sub SetLastError Lib "KERNEL32" (ByVal dwErrCode As Long)
  Private Declare PtrSafe Function GetVersion Lib "KERNEL32" () As Long
#Else
  Private Declare Function ExitWindowsEx Lib "user32" (ByVal dwOptions As Long, ByVal dwReserved As Long) As Long
  Private Declare Function GetLastError Lib "KERNEL32" () As Long
  Private Declare Function GetCurrentProcess Lib "KERNEL32" () As Long
  Private Declare Function OpenProcessToken Lib "advapi32" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
  Private Declare Function LookupPrivilegeValue Lib "advapi32" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID) As Long
  Private Declare Function AdjustTokenPrivileges Lib "advapi32" (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long
  Private Declare Sub SetLastError Lib "KERNEL32" (ByVal dwErrCode As Long)
  Private Declare Function GetVersion Lib "KERNEL32" () As Long
#End If
'Public glngWhichWindows32 As Long

Private Type LUID
  UsedPart As Long
  IgnoredForNowHigh32BitPart As Long
End Type

Private Type LUID_AND_ATTRIBUTES
  TheLuid As LUID
  Attributes As Long
End Type

Private Type TOKEN_PRIVILEGES
  PrivilegeCount As Long
  TheLuid As LUID
  Attributes As Long
End Type

Public Enum ExitMode
  Exit_LOGOFF = 0&
  Exit_SHUTDOWN = 1&
  Exit_REBOOT = 2&
  Exit_FORCE = 4&
  Exit_POWEROFF = 8&
  Exit_FORCEIFHUNG = &H10&
  Exit_RESTARTAPPS = &H40&
End Enum

Public Function ExitWindows(Optional ByVal ExitMode As ExitMode = Exit_SHUTDOWN Or Exit_FORCE) As Long

'********************************************************************
'* 这个过程允许程序在Windows下关机或者重新