Outlook2007送信前の宛先確認のVBAにて

質問

Outlook2007 送信前の宛先確認のマクロを設定したいと考えています。

Option Explicit

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
On Error GoTo Ex ception

Dim strCC
strCC = vbCrLf

Dim objRec As Recipients
For Each objRec In Item.Recipients
strCC = strCC & objRec.Name & vbCrLf
Next

Dim strMsg As String
strMsg = "件名:" & Item.Subject & vbCrLf & _
_
strCC & vbCrLf & _
_
"上記の宛先に、メールを送信してもよろしいですか?"

If MsgBox(strMsg, vbExclamation + vbYesNo + vbDefaultButton2) <> vbYes Then
Cancel = True
End If

On Error GoTo 0

Exit Sub

Exception:
MsgBox CStr(Err.Number) & ":" & Err.Description, vbOkOnly + vbCritical
Cancel = True
Exit Sub

これだけだと、End subが必要ですというポップアップがあがり、付加すると『型が一致しません』というポップアップがあがってしまいます。

どうすれば良いか教えていただけますか？
あと、宛先をグループ登録してる場合、グループ登録している宛先を氏名で表示する方法はありますでしょうか？？

回答No.1

end-u

OutlookVBAもそんなに詳しいわけではないですが試してみた感じだと以下のような。

Option Explicit

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
　　Dim objRec As Recipient
　　Dim strCC　As String
　　Dim strMsg As String
　　Dim s　　　As String　　　 '■変数追加
　　Dim a　　　As AddressEntry '■変数追加

　　On Error GoTo Exception
　　strCC = vbCrLf

　　For Each objRec In Item.Recipients
　　　　If objRec.AddressEntry.Members Is Nothing Then
　　　　　　s = objRec.Name
　　　　Else
　　　　　　s = ""
　　　　　　For Each a In objRec.AddressEntry.Members
　　　　　　　　s = s & a.Name & vbCrLf
　　　　　　Next
　　　　End If
　　　　strCC = strCC & s & vbCrLf
　　Next

　　strMsg = "件名:" & Item.Subject & vbCrLf & strCC & vbCrLf & _
　　　　　　 "上記の宛先に、メールを送信してもよろしいですか?"
　　If MsgBox(strMsg, vbExclamation + vbYesNo + vbDefaultButton2) <> vbYes Then
　　　　Cancel = True
　　End If
　　On Error GoTo 0
　　Exit Sub

Exception:
　　MsgBox CStr(Err.Number) & ":" & Err.Description, vbOKOnly + vbCritical
　　Cancel = True
End Sub

>『型が一致しません』
これは
>Dim objRec As Recipients
変数 objRec の 型の間違い。
正しくは Recipient です。
>For Each objRec In Item.Recipients
ここで Recipients コレクション をLoopして個々の Recipient オブジェクトに対して処理するわけだから
それに合った型を用意してあげないといけません。

>グループ登録している宛先を氏名で表示する方法
Typeで分岐できるのかもしれないけど取り合えず
Recipient オブジェクト の AddressEntry.Members をLoopして取得すれば良さそうでした。