有点问题,希望有人能帮帮我。
(展望 2010 VBA)
这是我当前的代码,我需要的是当我单击邮件时(仅单击我单击的邮件,而不是文件夹/同一位置中的每封邮件),它必须检查邮件的发件人是否已经在我的联系人中或在地址簿“所有用户”中,如果还不是其中之一,打开 AddContact 窗口并填写他/她的信息
还不行的是:
- 最重要的是,当我点击邮件时它不会运行脚本
- 当前检查联系人是否已经存在不起作用并使用vbMsgBox(是或否和响应的东西),如果联系人已经存在,那么这不是我想要/需要的,那么什么都没有发生。
我希望我提供了足够的信息,有人可以在这里帮助我:)
Sub AddAddressesToContacts(objMail As Outlook.MailItem)
Dim folContacts As Outlook.MAPIFolder
Dim colItems As Outlook.Items
Dim oContact As Outlook.ContactItem
Dim oMail As Outlook.MailItem
Dim obj As Object
Dim oNS As Outlook.NameSpace
''don't want or need a vbBox/ask box, this is a part of the current contactcheck
''wich doesn't work and is totaly wrong :P
Dim response As VbMsgBoxResult
Dim bContinue As Boolean
Dim sSenderName As String
On Error Resume Next
Set oNS = Application.GetNamespace("MAPI")
Set folContacts = oNS.GetDefaultFolder(olFolderContacts)
Set colItems = folContacts.Items
''this selects the mail that is currently selected.
''what i want is that the sender of the new incoming mail gets added to contacts
''(ofcourse, if that contact doesn't exsist yet)
''so the new incoming mail gotta be selected.
For Each obj In Application.ActiveExplorer.Selection
If obj.Class = olMail Then
Set oContact = Nothing
bContinue = True
sSenderName = ""
Set oMail = obj
sSenderName = oMail.SentOnBehalfOfName
If sSenderName = ";" Then
sSenderName = oMail.SenderName
End If
Set oContact = colItems.Find("[FullName] = '" & sSenderName & "'")
''this part till the --- is wrong, i need someting to check if the contact (the sender)
''already exsists. Any ideas?
If Not (oContact Is Nothing) Then
response = vbAbort
If response = vbAbort Then
bContinue = False
End If
End If
''---------
If bContinue Then
Set oContact = colItems.Add(olContactItem)
With oContact
.Email1Address = oMail.SenderEmailAddress
.Email1DisplayName = sSenderName
.Email1AddressType = oMail.SenderEmailType
.FullName = oMail.SenderName
'.Save
oContact.Display
End With
End If
End If
Next
Set folContacts = Nothing
Set colItems = Nothing
Set oContact = Nothing
Set oMail = Nothing
Set obj = Nothing
Set oNS = Nothing
End Sub
嘿,我还有最后一个问题,
'sets the name of the contact
Set oContact = colItems.Find("[FullName] = '" & sSenderName & "'")
'checks if the contact exsist, if it does exit the for loop
If Not oContact Is Nothing Then
Exit For
End If
End If
这会检查姓名是否已经在联系人中,我需要它检查电子邮件地址是否在联系人中,你能帮我吗?
我有这样的想法
set oSendermail = ?the e-mailaddress?
If Not oSendermail Is Nothing Then
Exit For
End If
End If