如何使用Access VBA执行筛选的Get-ADUser

Question

我的团队的任务是清除医疗应用程序用户帐户中的挂起的计划终止，如有必要，请向用户发送电子邮件以避免可能出现的问题。但是，医疗申请电子邮件记录经常不正确。

我正在为那些对PowerShell不太熟悉的同行创建一个MS Access工具，这是我通常用来处理用户帐户列表和挖掘电子邮件的工具。

使用VBA shell((函数运行已筛选的Get-ADUser命令时遇到困难。以下是我到目前为止所拥有的：

Dim runPwsh As String, getADemail As String, Surname As String, Givenname As String, pwshGetADEmail As String
'In production, Surname and GivenName will be variables from a form txtbox string
Surname = "Smith"
Givenname = "John"
getADemail = "Get-ADUser -filter " & """""""Surname -eq '" & Surname & "'" & " -and GivenName -like '" & Givenname & "*'"""""" -Property EmailAddress | %{$_.EmailAddress}"
pwshGetADEmail = "Powershell -Command """ & getADemail & """"
Debug.Print pwshGetADEmail
runPwsh = Shell(pwshGetADEmail, vbHide)

shell((函数命令应该看起来像：

Powershell -Command "Get-ADUser -filter """Surname -eq 'Smith' -and GivenName -like 'John*'""" -Property EmailAddress | %{$_.EmailAddress}"

如果从命令提示符执行，则该命令将返回有效结果。

然而，从Access中，我得到了一个错误"运行时错误"5"：过程或参数无效">

我已经花了几个小时在这上面了，但我想不出我遗漏了什么。

请协助。非常感谢。

Answer 1

我所在组织在所有工作站上安装的McAfee HIPS软件似乎阻止MS Office应用程序使用PowerShell命令运行VBA Shell((函数，从而生成运行时错误"5"：无效过程或参数错误。

语法正确。我通过在没有HIPS软件的虚拟主机上执行来确认这一点。

Dim runPwsh As String, getADemail As String, Surname As String, Givenname As String, pwshGetADEmail As String
Surname = Me.txtSurname
Givenname = Me.txtFirstname
getADemail = "Get-ADUser -filter " & """""""Surname -eq '" & Surname & "'" & " -and GivenName -like '" & Givenname & "*'"""""" -Property EmailAddress | %{$_.EmailAddress}"
pwshGetADEmail = "Powershell -Command """ & getADemail & """"
runPwsh = Shell(pwshGetADEmail, vbHide)

看来我需要找到一种不同的方法。

更新：20APR2022

能够让它发挥作用。从本质上讲，由于HIPS软件允许Shell(cmd.exe(，但不允许Shell(powershell.exe(，我想尝试一下类似的东西：

Call Shell("cmd.exe /c " powershell.exe -comment "Get-ADUser" "")

它成功了！下面是我的VBA代码：

用于使用SQL运行PowerShell以使用收集的Active Directory属性数组更新我的表的子：

Sub GetADInformation(argFullName As String)
DoEmptyClipboard = Shell("cmd.exe /c echo off | clip")
'Split argFullName with comma as delimeter
strFullName = Split(argFullName, ",")
strSurname = strFullName(0) 'AD: Surname
strGivenname = strFullName(1) 'AD: GivenName
'Build Get-ADUser command
strGetADUser = "Get-ADUser -filter " & """""" & _
"""Surname -eq '" & strSurname & "'" & _
" -and GivenName -like '" & strGivenname & "*'""""" & _
""" -Property SamAccountName,Division,EmailAddress,DistinguishedName | " & _
"%{$_.SamAccountName,$_.Division,$_.EmailAddress,$_.DistinguishedName}"
'Wrap Get-ADUser command within Command Prompt Powershell.exe with -Command parameter
'Results will be piped to clipboard
strPwsh = "Powershell -Command """ & strGetADUser & """| Clip"
'Use Shell() to run command prompt command
DoRunPwsh = Shell("CMD /C " & strPwsh, vbNormal)
'Wait 3-5 seconds for command to finish
Call WaitFor(5)
'Collect results from clipboard
ADarray = Clipboard_GetText()
'Visual Basic Carriage Return Line Feed (vbCrLf)
'Split ADArray with 'carriage return line feed' as delimiter
userADinfo = Split(ADarray, vbCrLf)
'Build SQL
strSQLupdate = "UPDATE tblUser SET " & _
"ADemail='" & userADinfo(2) & _
"', ADname='" & userADinfo(0) & _
"', ADdivision='" & userADinfo(1) & _
"', ADdistinguishedname='" & userADinfo(3) & _
"' WHERE FullName='" & argFullName & "';"

DoCmd.SetWarnings (False)
DoCmd.RunSQL strSQLupdate
DoCmd.SetWarnings (True)
End Sub

我从主窗体点击按钮调用了子窗体。

Private Sub btnGetAD_Click()
'exampleFullName = "Last,First M"
GetADInformation (exampleFullName)
End Sub

从剪贴板收集文本的功能

Public Function Clipboard_GetText() As String
On Error GoTo Error_Handler
StatusBar ("Extracting text from Clipboard...")
With CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
.GetFromClipboard
Clipboard_GetText = .GetText
End With

Error_Handler_Exit:
On Error Resume Next
Exit Function

Error_Handler:
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: Clipboard_GetText" & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has Occurred!"
Resume Error_Handler_Exit

End Function

用于延迟时间的Sub

Sub WaitFor(NumOfSeconds As Long)
Dim SngSec As Long
'VBA Timer function returns a Single(datatype) representing the number of seconds elapsed since midnight.
SngSec = Timer + NumOfSeconds
Do While Timer < SngSec
DoEvents
TimeRemaining = Abs(Timer - SngSec)
sTimeRemaining = "Time Remaining " & TimeRemaining & " Seconds"
StatusBar (sTimeRemaining)
Loop
End Sub