使用PowerShell调用CreateRecipient处理Outlook Exchange通讯组时程序挂起

极简复现代码 #

$targetEmail = Read-Host "Enter the email address:"
$outlook = New-Object -ComObject Outlook.Application
$namespace = $outlook.GetNamespace("MAPI")
$recipient = $namespace.CreateRecipient($targetEmail)

挂起语句 #

$recipient = $namespace.CreateRecipient($targetEmail)

已尝试的解决方法 #

• 重启Outlook
• 因Outlook为32位版本，从64位PowerShell切换到32位PowerShell运行代码

补充背景 #

$targetEmail是Outlook Exchange通讯组地址。已有可正常运行的VBA代码用于获取嵌套通讯组并展开所有成员，现尝试迁移到PowerShell。

可用的VBA代码 #

Sub SaveDistributionListMembers()
    Dim olApp As Outlook.Application
    Dim olNamespace As Outlook.NameSpace
    Dim recipient As Outlook.recipient
    Dim rootDL As Outlook.AddressEntry
    Dim emailList As Collection
    Dim downloadsPath As String
    Dim fso As Object, outFile As Object
    Dim targetEmail As String
    Dim email As Variant
    
    targetEmail = InputBox("Enter the email address of the distribution list:", "DL Email Input")
    If Trim(targetEmail) = "" Then
        MsgBox "No email address entered. Cancelled.", vbExclamation
        Exit Sub
    End If

    Set olApp = Application
    Set olNamespace = olApp.GetNamespace("MAPI")
    Set recipient = olNamespace.CreateRecipient(targetEmail)

    If recipient.Resolve Then
        Set rootDL = recipient.AddressEntry
        Set emailList = New Collection
        CollectEmailsRecursive rootDL, emailList

        ' Get path to Downloads folder
        downloadsPath = Environ("USERPROFILE") & "\Downloads\DistributionList_Emails.txt"
        
        Set fso = CreateObject("Scripting.FileSystemObject")
        Set outFile = fso.CreateTextFile(downloadsPath, True)

        For Each email In emailList
            outFile.WriteLine email
        Next

        outFile.Close
        MsgBox "Email addresses saved to: " & downloadsPath
    Else
        MsgBox "Could not resolve email address: " & targetEmail
    End If
End Sub

Sub CollectEmailsRecursive(entry As Outlook.AddressEntry, ByRef emailList As Collection)
    Dim members As Outlook.AddressEntries
    Dim member As Outlook.AddressEntry
    Dim i As Long
    Dim smtp As String

    If entry.AddressEntryUserType = olExchangeDistributionListAddressEntry Then
        On Error Resume Next
        Set members = entry.members
        If members Is Nothing Then Exit Sub

        For i = 1 To members.Count
            Set member = members.Item(i)
            If IsDistributionList(member) Then
                ' Recurse
                CollectEmailsRecursive member, emailList
            Else
                smtp = GetSMTPAddress(member)
                If Len(smtp) > 0 Then
                    On Error Resume Next
                    emailList.Add smtp, smtp ' Prevent duplicates using key
                    On Error GoTo 0
                End If
            End If
        Next i
    End If
End Sub

Function IsDistributionList(entry As Outlook.AddressEntry) As Boolean
    IsDistributionList = (entry.AddressEntryUserType = olExchangeDistributionListAddressEntry)
End Function

Function GetSMTPAddress(entry As Outlook.AddressEntry) As String
    Dim exchUser As Outlook.ExchangeUser
    Dim exchDL As Outlook.ExchangeDistributionList

    On Error Resume Next

    If entry.AddressEntryUserType = olExchangeUserAddressEntry Or _
       entry.AddressEntryUserType = olExchangeRemoteUserAddressEntry Then
        Set exchUser = entry.GetExchangeUser
        If Not exchUser Is Nothing Then
            GetSMTPAddress = exchUser.PrimarySmtpAddress
            Exit Function
        End If
    ElseIf entry.AddressEntryUserType = olExchangeDistributionListAddressEntry Then
        Set exchDL = entry.GetExchangeDistributionList
        If Not exchDL Is Nothing Then
            GetSMTPAddress = exchDL.PrimarySmtpAddress
            Exit Function
        End If
    Else
        GetSMTPAddress = entry.Address
    End If
End Function

编写的PowerShell代码 #

# Prompt for DL email address
$targetEmail = Read-Host "Enter the email address of the distribution list"

# Create Outlook COM objects
$outlook = New-Object -ComObject Outlook.Application
$session = $outlook.Session
$session.Logon("Outlook")
$namespace = $outlook.GetNamespace("MAPI")
$recipient = $namespace.CreateRecipient($targetEmail)

# HashSets to avoid duplicates and circular loops
$emailSet = New-Object System.Collections.Generic.HashSet[string]
$visitedDLs = New-Object System.Collections.Generic.HashSet[string]

# Recursive function to expand DL
function Expand-DL($addressEntry) {
    try {
        if ($addressEntry.AddressEntryUserType -eq 1) {  # Distribution List
            $dlSmtp = Get-SMTPAddress $addressEntry
            if ($dlSmtp -and !$visitedDLs.Contains($dlSmtp)) {
                $visitedDLs.Add($dlSmtp) | Out-Null
                $members = $addressEntry.Members
                if ($members -ne $null) {
                    foreach ($member in $members) {
                        Expand-DL $member
                    }
                }
            }
        } else {
            $smtp = Get-SMTPAddress $addressEntry
            if ($smtp -and !$emailSet.Contains($smtp)) {
                $emailSet.Add($smtp) | Out-Null
            }
        }
    } catch {
        Write-Host "Error expanding entry: $($addressEntry.Name)"
    }
}

# Get SMTP address
function Get-SMTPAddress($entry) {
    try {
        switch ($entry.AddressEntryUserType) {
            0 { return $entry.Address }
            5 {
                $user = $entry.GetExchangeUser()
                if ($user) { return $user.PrimarySmtpAddress }
            }
            1 {
                $dl = $entry.GetExchangeDistributionList()
                if ($dl) { return $dl.PrimarySmtpAddress }
            }
            default { return $entry.Address }
        }
    } catch {
        return $null
    }
}

# Start resolving
if ($recipient.Resolve()) {
    $root = $recipient.AddressEntry
    Expand-DL $root

    # Output path
    $downloads = [Environment]::GetFolderPath("Downloads")
    $outPath = Join-Path $downloads "DistributionList_Emails.txt"
    $emailSet | Sort-Object | Set-Content -Path $outPath -Encoding UTF8

    Write-Host "`nSaved to: $outPath"
} else {
    Write-Host "❌ Could not resolve: $targetEmail"
}

内容的提问来源于stack exchange，提问作者WG-