Option Explicit
#If VBA7 = 0 Then
Private Enum LongPtr: [_]: End Enum
#End If
Private Const LOGON_WITH_PROFILE As Long = &H1
Private Const LOGON_NETCREDENTIALS_ONLY = &H2
Private Const LOGON32_LOGON_INTERACTIVE = 2
Private Const LOGON32_PROVIDER_DEFAULT = 0
Private Const INFINITE As Long = &HFFFFFFFF
Private Type STARTUPINFOW
cb As Long
lpReserved As LongPtr
lpDesktop As LongPtr
lpTitle As LongPtr
dwX As Long
dwY As Long
dwXSize As Long
dwYSize As Long
dwXCountChars As Long
dwYCountChars As Long
dwFillAttribute As Long
dwFlags As Long
wShowWindow As Integer
cbReserved2 As Integer
lpReserved2 As Byte
hStdInput As LongPtr
hStdOutput As LongPtr
hStdError As LongPtr
End Type
Private Type PROCESS_INFORMATION
hProcess As LongPtr
hThread As LongPtr
dwProcessId As Long
dwThreadId As Long
End Type
#If VBA7 Then
Private Declare PtrSafe Function CreateProcessWithLogonW Lib "advapi32" (ByVal UserName As LongPtr, _
ByVal Domain As LongPtr, ByVal Password As LongPtr, ByVal dwLogonFlags As Long, _
ByVal ApplicationName As LongPtr, ByVal strCommandLine As Long, ByVal dwCreationFlags As Long, _
ByVal lpEnvironment As LongPtr, ByVal strCurrentDirectory As LongPtr, ByVal lpStartupInfo As LongPtr, _
ByVal lppiProcessInfo As LongPtr) As Long
Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As LongPtr, ByVal lpOperation As String, ByVal lpFile As String, _
ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Declare PtrSafe Function WaitForSingleObject Lib "kernel32.dll" (ByVal hHandle As LongPtr, ByVal dwMilliseconds As Long) As Long
Private Declare PtrSafe Function CloseHandle Lib "kernel32.dll" (ByVal hObject As LongPtr) As Long
#Else
Private Declare Function CreateProcessWithLogonW Lib "advapi32" (ByVal UserName As Long, _
ByVal Domain As Long, ByVal Password As Long, ByVal dwLogonFlags As Long, _
ByVal ApplicationName As Long, ByVal strCommandLine As Long, ByVal dwCreationFlags As Long, _
ByVal lpEnvironment As Long, ByVal strCurrentDirectory As Long, ByVal lpStartupInfo As Long, _
ByVal lppiProcessInfo As Long) As Long
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32.dll" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
#End If
Public Function RunAsUser(ByVal UserName As String, ByVal Password As String, _
ByVal DomainName As String, AppName As String, Optional ByVal Wait As Boolean = False) As Long
Dim si As STARTUPINFOW
Dim pi As PROCESS_INFORMATION
Dim wUser As LongPtr
Dim wDomain As LongPtr
Dim wPassword As LongPtr
Dim wAppName As LongPtr
Dim Result As Long
si.cb = Len(si)
wUser = StrPtr(UserName & Chr(0))
wDomain = StrPtr(DomainName & Chr(0))
wPassword = StrPtr(Password & Chr(0))
wAppName = StrPtr(AppName & Chr(0))
Result = CreateProcessWithLogonW(wUser, wDomain, wPassword, LOGON_WITH_PROFILE, wAppName, 0, 0, 0, 0, VarPtr(si), VarPtr(pi))
If Result <> 0 Then ' thanh cong
' neu Wait TRUE thi code dung o dong WaitForSingleObject cho toi khi process cua wAppName ket thuc
' sau do moi chay tiep code CloseHandle pi.hThread
If Wait Then WaitForSingleObject pi.hProcess, INFINITE
CloseHandle pi.hThread
CloseHandle pi.hProcess
RunAsUser = 0
Else
' that bai
RunAsUser = Err.LastDllError
MsgBox "CreateProcessWithLogonW that bai " & Err.LastDllError, vbExclamation
End If
End Function
