0

送信するすべてのメールで BCC を送信するコードを VBA Outlook 2016 に書きたいと思います。多くの送信者 mail 、1 つの Outlook アカウントに多くのメールがあります。

したがって、x@domaine.com からメールを送信するたびに、x@domaine.com から BCC メールが自動的に送信されます。y@domaine1.com から送信した場合も、y@domaine1.com に BCC が送信されます。

このコードを試しましたが、機能しません。セキュリティ マクロではすべてが有効になっています

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim objRecip As Recipient
Dim strMsg As String
Dim res As Integer
Dim strBcc As String
Dim myOlApp As Outlook.Application
Dim myOlMsg As Outlook.MailItem

On Error Resume Next

Set myOlApp = CreateObject("Outlook.Application")
Set myMsg = myOlApp.ActiveInspector.CurrentItem

strBcc = myMsg.SenderEmailAddress

Set objRecip = Item.Recipients.Add(strBcc)
objRecip.Type = olBCC
If Not objRecip.Resolve Then
strMsg = "Could not resolve the Bcc recipient. " & _
"Do you want still to send the message?"
res = MsgBox(strMsg, vbYesNo + vbDefaultButton1, _
"Could Not Resolve Bcc Recipient")
If res = vbNo Then
  Cancel = True
End If
End If
Set objRecip = Nothing

End Sub
4

3 に答える 3

0

送信されるアイテムは、パラメーターとしてコードに渡されます。使用しないでくださいmyOlApp.ActiveInspector.CurrentItem。インスペクターが既に閉じられているか、メッセージがインライン応答として作成されている可能性があります。

于 2016-01-14T13:53:38.747 に答える
0

あなたの質問について少し混乱しています。あなたの見通しに複数のアカウントが設定されていると仮定すると、これはあなたに与えるはずですCurrenUser. プロパティを使用して、現在ログオンしているユーザーの名前を取得します。

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    Dim olNamespace As Outlook.NameSpace
    Dim olRec As Outlook.Recipient
    Dim Address$

    Set olNamespace = Application.GetNamespace("MAPI")

    Address = olNamespace.CurrentUser

    Set olRec = Item.Recipients.Add(Address)
    olRec.Type = olBCC
    olRec.Resolve
End Sub
于 2016-01-14T09:04:40.430 に答える