Question

我有一张Excel工作表，其中包含三列Employee Name，Email ID和DOB。

我写了一个宏，它将员工的出生日期与今天的日期相匹配，该日期将向客户和Cc部门发送Outlook邮件。

当所有员工看到该邮件时，他们可以点击回复或回复所有邮件。

我写了另一个Outlook宏，用他/她的生日人电子邮件ID替换To address字段。

第二个宏正在任何打开的Outlook电子邮件上处理我的系统。

因为我有Outlook宏，所以我能够执行它，但要在所有员工系统中执行相同的操作，他们需要这个Outlook宏。如何在不将这个宏手动放入系统的情况下在系统中运行它？

Answer 1

以下代码假定ObjMail是您正在创建的消息。

' Delete any existing reply recipients
Do While ObjMail.ReplyRecipients.Count > 0
  ObjMail.ReplyRecipients.Remove 1
Loop

' Add the new recipient
ObjMail.ReplyRecipients.Add "BirthdayPerson@isp.com"

' Send blind copy to other staff members
ObjMail.BCC = "Staff1.isp.com, Staff2.isp.com, Staff3.isp.com"

发送给工作人员的消息会说它来自发送生日消息的人。但如果有人回复，收件人将是“BirthdayPerson@isp.com”。

我已向其他工作人员发送了盲文。这不是因为员工名单是秘密的，而是因为：

如果您有500名工作人员，每个地址平均有20个字符，则使用CC会在500封邮件中添加10,000个字符。
在保存其他500 * 500条消息时，它会阻止员工使用“全部回复”。
如果您希望填写公司的服务器，请使用ObjMail.CC。

我担心邮件大小，因为很多年前我在英国NHS工作，有数千名员工分散在全国各地。一家小医院的人试图在医院内宣传他的自行车出售，但设法向该国的每位员工做广告。我在家里用慢速拨号线工作;下载此消息花了半个小时。

响应对测试例程完整代码的请求的新部分

下面我列出了我用来测试答案的完整例程。它改编自我为另一个答案写的例程。它会创建一个您可能不想要的HTML主体，但会告诉您如何操作。我用虚拟地址替换了我用于测试的真实电子邮件地址;否则它没有变化。

Sub ReplyToRecipientWithBlindCopies()

  ' Create a mail item with a simple message.
  ' Send the mail item to "BirthdayPerson@isp.com" and make them
  ' the recipient of any replies.
  ' Send blind copies to all other recipients.

  ' Author: Tony Dallimore, York, England

  Dim OlApp As Outlook.Application
  Dim ObjMail As Outlook.MailItem

  Dim MessageBody As String

  ' This creates a blue message on a grey background.  This is a
  ' demonstration of what is possible; not a recommendation!
  MessageBody = "<table width=""100%"" style=""Color:#0000FF;" & _
         " background-color:#F0F0F0;""><tr><td align= ""center"">" & _
         "Happy birthday from all your colleagues!</td></tr></table>"

  Set OlApp = Outlook.Application
  Set ObjMail = OlApp.CreateItem(olMailItem)
  With ObjMail
    .BodyFormat = olFormatHTML
    .Subject = "Happy birthday!"
    .HTMLBody = HeadAndBodyToHtmlDoc("", MessageBody)

    ' Remove any existing recipients
    Do While .Recipients.Count > 0
      .Recipients.Remove 1
    Loop
    ' Remove any existing reply recipients
    Do While .ReplyRecipients.Count > 0
      .ReplyRecipients.Remove 1
    Loop

    ' Add birthday person to Recipient and ReplyRecipient lists
    .Recipients.Add "BirthdayPerson@isp.com"
    .ReplyRecipients.Add "BirthdayPerson@isp.com"

    ' You will need to replace this with a loop
    ' to add all your staff members.
    .BCC = "Staff1@isp.com, Staff2@isp.com, Staff3@isp.com"

    ' Display the prepared messages ready for any final changes.
    ' The user must send it.
    .Display
  End With

End Sub
Function HeadAndBodyToHtmlDoc(Head As String, Body As String) As String

  ' Wrap Head and Body created by caller in a standard envelope.

  ' Author: Tony Dallimore, York, England

  HeadAndBodyToHtmlDoc = _
        "<!DOCTYPE html PUBLIC ""-//W3C//DTD XHTML 1.0 Frameset//EN""" & _
        " ""http://www.w3.org/TR/xhtml1/DTD/xhtml1-frameset.dtd"">" & _
        vbCr & vbLf & "<html xmlns=""http://www.w3.org/1999/xhtml""" & _
        " xml:lang=""en"" lang=""en"">" & vbCr & vbLf & "<head><meta " & _
        "http-equiv=""Content-Type"" content=""text/html; " & _
        "charset=utf-8"" />" & vbCr & vbLf & Head & vbCr & vbLf & _
        "</head><body>" & vbCr & vbLf & Body & "</body></html>"

End Function

更改Outlook邮件中的回复地址

1 个答案: