VBA/Excel/Access/Word/Outlook/Outlook Contact
Содержание
add a contact through VBA
<source lang="vb">
Sub AddAContact()
Dim myOutlook As Outlook.Application Dim myItems As ContactItem Set myOutlook = CreateObject("Outlook.Application") Set myItems = myOutlook.CreateItem(olContactItem) With myItems .FirstName = "John" .LastName = "Smith" .Email1Address = "j@yourserver.ru" .Save End With
End Sub
</source>
Add new contact item to Outlook
<source lang="vb">
Sub AddAContact()
Dim myOutlook As Outlook.Application Dim myItems As ContactItem Set myOutlook = CreateObject("Outlook.Application") Set myItems = myOutlook.CreateItem(olContactItem) With myItems .FirstName = "John" .LastName = "Smith" .Email1Address = "johnsmith@yoursite.ru" .Save End With
End Sub
</source>
Add recipient
<source lang="vb">
Public Sub AddRecipient()
Dim oSelect As Outlook.SelectNamesDialog Dim colRecipients As Outlook.Recipients Dim oRecip As Outlook.Recipient Dim oMail As Outlook.MailItem Set oMail = Application.CreateItem(olMailItem) Set oSelect = Application.Session.GetSelectNamesDialog With oSelect .AllowMultipleSelection = False .SetDefaultDisplayMode OlDefaultSelectNamesDisplayMode.olDefaultMail .ForceResolution = True .Caption = "My Mail Selector Dialog" .ToLabel = "My To Selector" .NumberOfRecipientSelectors = OlRecipientSelectors.olShowTo .Display If .Recipients.Count = 1 Then Set oRecip = oMail.Recipients.Add(.Recipients.Item(1).Name) End If End With oMail.Display
End Sub
</source>
Create Outlook.Application
<source lang="vb">
Sub myAddressBook()
Dim myOutlook As Outlook.Application Dim myInformation As Namespace Dim mycontacts As Items Dim myItems As ContactItem Set myOutlook = CreateObject("Outlook.Application") Set myInformation = myOutlook.GetNamespace("MAPI") Set mycontacts = myInformation.GetDefaultFolder(olFolderContacts).Items For Each myItems In mycontacts Debug.Print myItems.FirstName, myItems.LastName, myItems.Email1Address Next
End Sub
</source>
Delete a contact from Outlook
<source lang="vb">
Sub DeleteaContact()
Dim myOutlook As Outlook.Application Dim myInformation As Namespace Dim myContacts As Items Dim myItems As ContactItem Set myOutlook = CreateObject("Outlook.Application") Set myInformation = myOutlook.GetNamespace("MAPI") Set myContacts = myInformation.GetDefaultFolder(olFolderContacts).Items For Each myItems In myContacts If myItems.Email1Address = "j@yoursite.ru" Then myItems.Delete End If Next
End Sub
</source>
Print all names from your contact list in Outlook
<source lang="vb">
Sub myAddressBook()
Dim myOutlook As Outlook.Application Dim myInformation As Namespace Dim mycontacts As Items Dim myItems As ContactItem Set myOutlook = CreateObject("Outlook.Application") Set myInformation = myOutlook.GetNamespace("MAPI") Set mycontacts = myInformation.GetDefaultFolder(olFolderContacts).Items For Each myItems In mycontacts Debug.Print myItems.FirstName, myItems.LastName, myItems.Email1Address Next
End Sub
</source>