Board logo

標題: [發問] 關機問題 [打印本頁]
作者: spermbank    時間: 2016-7-27 17:07     標題: 關機問題

大家好:

     請問一下，我想用excel vba執行完程式後，自動關閉電腦。
     查了很久，不知道怎麼樣用vba程式來關機，所以請教一下大家，感謝。
作者: Joforn    時間: 2016-7-28 21:00

本帖最後由 Joforn 於 2016-7-28 21:03 編輯

注意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下关机或者重新
作者: jackyq    時間: 2016-7-28 21:19

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    時間: 2016-7-28 21:20

回復 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

  21. Private Type LUID
  22.   UsedPart As Long
  23.   IgnoredForNowHigh32BitPart As Long
  24. End Type

  26. Private Type LUID_AND_ATTRIBUTES
  27.   TheLuid As LUID
  28.   Attributes As Long
  29. End Type

  31. Private Type TOKEN_PRIVILEGES
  32.   PrivilegeCount As Long
  33.   TheLuid As LUID
  34.   Attributes As Long
  35. End Type

  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

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

  49. '********************************************************************
  50. '* 這個程式用來關閉、重啟計算機或是登出當前用戶
  51. '********************************************************************

  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

  88. Sub PowerOff()
  89.   ExitWindows Exit_POWEROFF Or Exit_FORCE
  90. End Sub
複製代碼
上一樓回復不知為何被論壇吃掉了一半的代碼……
作者: Joforn    時間: 2016-7-28 21:29

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



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)