③「Microsoft Outlook XX.X Object Library」を探してチェックボックスにチェックし「OK」をクリックします。
以上です。
Outlookの追加したフォルダの連絡先へ登録/更新するVBA
Outlookの追加したフォルダの連絡先へ登録/更新するVBAを実装していきましょう。
VBAを実装する
サンプルコードは以下の通りとなります。
Sub Outlookの追加フォルダの連絡先を登録_更新する()
'Outlook用の定義
Dim olApp As Outlook.Application
Dim olNamespace As Outlook.Namespace
Dim olFolder As Outlook.MAPIFolder
Dim olConItems As Outlook.Items
Dim olItem As Object
Dim olItemBefor As Object
'Excel用の定義
Dim wbBook As Workbook
Dim wsSheet As Worksheet
Dim lnContactCount As Long
'スクリーンの更新を行わないようにします。
Application.ScreenUpdating = False
'Excelのブックとワークシートのオブジェクトを設定します。
Set wbBook = ThisWorkbook
Set wsSheet = wbBook.Worksheets(1)
'Outlookオブジェクトを設定し、MAPI名前空間を介してOutlookの共有の連絡先一覧を取得します。
Set olApp = New Outlook.Application
Set olNamespace = olApp.GetNamespace("MAPI")
Set olFolder = olNamespace.GetDefaultFolder(olFolderContacts).Folders("＜追加したフォルダ名を指定＞")
Set olConItems = olFolder.Items
'取得結果を記述する行番号を指定します。2行目のセルから開始されることになります。
lnContactCount = 2
'Excelシートをアクティブにします。
wsSheet.Activate
If MsgBox("追加フォルダの連絡先を更新しますか？", vbYesNo + vbQuestion, "確認") = vbYes Then
'連絡先一覧の件数分繰り返す。
For i = lnContactCount To Cells(1, 3).End(xlDown).Row
'EntryIDの有無を確認します。
If wsSheet.Cells(i, 12) <> "" Then
For Each olItemBefor In olConItems
'連絡先のEntryIDをキーにして共有の連絡先を検索します。
If olItemBefor.EntryID = wsSheet.Cells(i, 12) Then
'連絡先のEntryIDと一致していたら、該当アイテムをオブジェクトに設定します。
Set olItem = olItemBefor
End If
Next
Else
'EntryIDがない場合、連絡先オブジェクトを新規作成します。
Set olItem = olFolder.Items.Add(olContactItem)
End If
'アイテムのタイプが連絡先"ContactItem"であるか判定します。
If TypeName(olItem) = "ContactItem" Then
With olItem
'連絡先の各項目へ値を代入します。
.CompanyName = wsSheet.Cells(i, 1).Value
.Department = wsSheet.Cells(i, 2).Value
.LastName = wsSheet.Cells(i, 3).Value
.YomiLastName = wsSheet.Cells(i, 4).Value
.FirstName = wsSheet.Cells(i, 5).Value
.YomiFirstName = wsSheet.Cells(i, 6).Value
'.FullName = Cells(i, 7) 'フルネームは姓、名より優先的に更新されるため無効化しています。
.Email1Address = wsSheet.Cells(i, 8).Value
.Email1DisplayName = wsSheet.Cells(i, 9).Value
.MobileTelephoneNumber = wsSheet.Cells(i, 10).Value
.Body = wsSheet.Cells(i, 11).Value
End With
'連絡先アイテムを保存します。
olItem.Save
If wsSheet.Cells(i, 12).Value = "" Then
'発行されたEntryIDをExcelへ書き込みします。
wsSheet.Cells(i, 12).Value = olItem.EntryID
End If
End If
Next
'スクリーンの更新を行います。
Application.ScreenUpdating = True
MsgBox "Outlookの追加フォルダの連絡先の反映が完了しました！", vbInformation
Else
MsgBox "処理を中断します"
End If
'オブジェクトを解放します。
Set olItem = Nothing
Set olConItems = Nothing
Set olFolder = Nothing
Set olNamespace = Nothing
Set olApp = Nothing
Set olItemBefor = Nothing
End Sub
コメントを残す