以下程序是从Outlook 2010中新组合的电子邮件帐户中提取收件人电子邮件地址。然后将其插入电子邮件正文中,并且工作正常。
但是,我只想提取和插入真实地址。现在程序将获取John Dow (john@isp.com); John1 Dow (john1@isp.com)
等地址,并按原样将其插入电子邮件正文中。
我需要的是提取地址并仅插入地址john@isp.com; john@isp.com
而不使用每个地址之前的全名。
感谢您的帮助。以下是我正在使用的代码 -
Sub copy_change() 'read the recepients of the new email and add them to the text body where the curser is.
Dim eRecipients As String
eRecipients = Application.ActiveInspector.currentItem.To
Dim objDoc As Word.Document, objSel As Word.Selection
On Error Resume Next
'~~> Get a Word.Selection from the open Outlook item
Set objDoc = Application.ActiveInspector.WordEditor
Set objSel = objDoc.Windows(1).Selection
'~~> Type Relevant Text
objSel.TypeText "Recipient : " & eRecipients
Set objDoc = Nothing
Set objSel = Nothing
End Sub
答案 0 :(得分:1)
替换
行eRecipients = Application.ActiveInspector.currentItem.To
与
dim recip As Recipient
eRecipients = ""
for each recip in Application.ActiveInspector.CurrentItem.Recipients
if Recip.Type = olTo Then
if (eRecipients <> "") Then eRecipients = eRecipients & ", "
eRecipients = eRecipients & recip.Address
End If
next