[VBA][Outlook]CDO.Messageでエイリアスに紐づくメールアドレスに送信したい

Question

前提

ExcelVBAのCDO.Messageを使って差出人を指定し、Excelで計算された、社員番号に紐づくデータを、社員番号に対応したメールアドレスに送信したいです。
ただし、現在社員番号に対応するメールアドレスのマスターは存在しません。
各社員のメールアドレスにはエイリアスが登録されており、Outlook上で宛先に7桁の番号を入れることで、その人に送信することは出来ます。

やりたいこと

次のいずれか１つです。

• Outlookから自社員のメールアドレスとエイリアスを出力する
• Outlookでエイリアスを経由して宛先を指定するのと同じことをCDO.Messageで行いたい

Answer 1

https://qiita.com/Q11Q/items/92c1954e4dcdcc7fa598
ExcelでOutlookのアドレス帳を会社名で検索して、メールアドレスを抜き出す

ずれていたらすみません

Answer 2

参考：Excel vba outlookのExchangeのグローバルアドレス一覧から特定の肩書から名前を検索するマクロ

Excelに”DATA"という名前のテーブルを用意し、マクロを実行すれば、対象のエイリアスとメールアドレスを出力できました。

Sub GetNameFromOlGlobalAddress()

        Dim ls As ListObject: Set ls = Range("DATA").ListObject
        If Not ls.DataBodyRange Is Nothing Then ls.DataBodyRange.Delete
        
        ' Create an Outlook application.
        Dim oApp As Outlook.Application: Set oApp = CreateObject("Outlook.Application")
        Dim oNS As Outlook.Namespace: Set oNS = GetNamespace("MAPI")
        
        Dim colAL As Outlook.AddressLists ' Outlook.AddressLists
        Dim oAL As Outlook.AddressList ' Outlook.AddressList
        Dim colAE As Outlook.AddressEntries
        Dim oAE As Outlook.addressEntry
        Dim AddressLists As Outlook.AddressLists
        
        ' Outlook.AddressEntries
        Dim addressEntry As Object ' Outlook.AddressEntry
        Dim oExuser As Outlook.ExchangeUser
        Set AddressLists = oNS.AddressLists
        
        '確認して変更する
        Set oAL = oNS.AddressLists.Item("GALの名前") 'GALを絞り込む 'Set oAL = oNS.AddressLists.Item("JPNTOKYO_0001新宿支店")
        Set colAE = oAL.AddressEntries
    
        For Each oAE In colAE
            Set oExuser = oAE.GetExchangeUser
            If oAE.AddressEntryUserType = olExchangeUserAddressEntry Then
            
                Set oExuser = oAE.GetExchangeUser
                If oExuser.OfficeLocation = "hogefuga Head Office" Then
                    With oExuser
                        ls.ListRows.Add.Range.Value = Array(.Alias, .PrimarySmtpAddress, .BusinessTelephoneNumber)
                    End With
                End If
            End If
        Next
End Sub