Excel VBAにて、Outlookの連絡先グループを含む連絡先グループを作成したい。

前提

Excel VBAにて、Outlookのアドレス帳を更新するシステムを作っています。
連絡先グループを含む連絡先グループを作成するな機能を実装しようとしていますが、処理が実行されません。

実現したいこと

連絡先グループを含む連絡先グループを作成したい。

発生している問題・エラーメッセージ

エラーメッセージは発生していません。 見かけ上は、エラーが無く、下記コードが終了します。

該当のソースコード

VBA

Option Explicit Sub 連絡先グループを含む連絡先グループを作成する() '参照設定は以下を設定しております。 'Visual Basic For Application 'Microsoft Excel 16.0 Object Library 'OLE Automation’Microsoft Outlook 16.0 Object Library 'Microsoft Office 16.0 Object Library 'Microsoft Froms 2.0 Object Library Dim olApp As Outlook.Application Set olApp = New Outlook.Application Dim oNs As Outlook.Namespace Set oNs = olApp.GetNamespace("MAPI") Dim oContact As Outlook.Folder Set oContact = oNs.GetDefaultFolder(olFolderContacts) Dim oItems As Outlook.Items Set oItems = oContact.Items Dim oDistList As Outlook.DistListItem Dim addAddress As Recipient '-------------------------------------------------------- Set oDistList = oItems.Add(olDistributionListItem) oDistList.DLName = "A社" Set addAddress = Session.CreateRecipient("A社の経理<Akeiri@example.com>") addAddress.Resolve oDistList.addMember addAddress Set addAddress = Session.CreateRecipient("A社の営業<Aeigyou@example.com>") addAddress.Resolve oDistList.addMember addAddress oDistList.Save '-------------------------------------------------------- '-------------------------------------------------------- Set oDistList = oItems.Add(olDistributionListItem) oDistList.DLName = "B社" Set addAddress = Session.CreateRecipient("B社の経理<Bkeiri@example.com>") addAddress.Resolve oDistList.addMember addAddress oDistList.Save '-------------------------------------------------------- '-------------------------------------------------------- Set oDistList = oItems.Add(olDistributionListItem) oDistList.DLName = "C社" Set addAddress = Session.CreateRecipient("C社の経理<Ckeiri@example.com>") addAddress.Resolve oDistList.addMember addAddress Set addAddress = Session.CreateRecipient("C社の営業<Ceigyou@example.com>") addAddress.Resolve oDistList.addMember addAddress oDistList.Save '-------------------------------------------------------- '*****思うように動かない箇所***************************** Set oDistList = oItems.Add(olDistributionListItem) oDistList.DLName = "全社" Set addAddress = Session.CreateRecipient("A社") addAddress.Resolve oDistList.addMember addAddress Set addAddress = Session.CreateRecipient("B社") addAddress.Resolve oDistList.addMember addAddress Set addAddress = Session.CreateRecipient("C社") addAddress.Resolve oDistList.addMember addAddress oDistList.Save '*****思うように動かない箇所***************************** Set oItems = Nothing Set oContact = Nothing Set oNs = Nothing Set olApp = Nothing End Sub

試したこと

ここに問題に対して試したことを記載してください。
上記コードを実行したところ、メールアドレスだけの連絡先グループは上手く設定できます。

イメージ説明

Outlookをマウスを操作して、手動で「全社」にA社、B社、C社を追加すると手く設定できます。

補足情報(FW/ツールのバージョンなど)

ここにより詳細な情報を記載してください。

コメントを投稿

0 コメント