Geçen gün gelen maillerdeki bütün e-posta adreslerini,toplu olarak kişi adres defterime eklemem gerekti.Yaklaşk 200 tane email adresi var ve bunları tek tek elle eklemek çok zamanımı alacaktı.
Biraz araştırdıktan sonra outlook 2007 ve 2003 versiyonlarında böyle bir özelliğin olmadığını öğrendim.Beta aşamasında olan Outlook 2010 sürümünde varmış sadece..Neyseki VB Script ile yapılabiliyormuş.

Daha ayrıntılı bilgi ve nasıl yapıldığını görmek için döküman’dan devam ediniz..

Outlook’u açınız , üst menüden Araçlar -> Makro -> Visual Basic Düzenleyicisi‘ne girin.

Resim-1

Sol taraftan yeni modüle açın.

Resim-2

VB Script kodunu yapıştırın ve sol üstten kaydedin.

Resim3

Outlook’ta Araçlar -> Kurallar ve Uyarılar menüsünü açın.

Resim-4

Yeni kural oluşturun , Boş bir kuraldan başla ve Ulaştığında iletileri denetle sekmelerini seçin.

Resim-5

Bir sonraki pencerede yanlızca bana gönderilen sekmesini işaretleyin ve ileriyi tıklayın.

Resim-6

Komut dosyası öğesini çalıştır sekmesini işaretleyin ve kaydettiğiniz  komut dosyasını seçin.

Resim-7

Son diyerek kuralı bitiriyoruz.

Resim-8

Son olarak oluşturduğumuz bu kuralı çalıştırıyoruz.

Hepsi bitti , şimdi adres defterinizi kontrol edin.Bütün mail adreslerinin kaydedilmiş olduğunu göreceksiniz. VB Script kodumuz şu şekildedir;

Sub AutoAddContact(Item As MailItem)
    Dim olkContacts As MAPIFolder, _
        olkContact As ContactItem, _
        olkReply As MailItem, _
        olkRecip As Recipient, _
        strAddress As String
    Set olkContacts = Outlook.Application.Session.GetDefaultFolder(olFolderContacts)
    Set olkContact = olkContacts.Items.Find("[FullName] = '" & Item.SenderName & "'")
    If TypeName(olkContact) = "Nothing" Then
        Set olkContact = Outlook.Application.CreateItem(olContactItem)
        Set olkReply = Item.Reply
        Set olkRecip = olkReply.Recipients.Item(1)
        If Err = 0 Then
            strAddress = olkRecip.Address
            If strAddress = "" Then
                strAddress = olkRecip.Name
            End If
        End If
        With olkContact
            .Email1Address = strAddress
            .FullName = Item.SenderName
            'Feel free to remove the next line'
            .Body = "Record created automatically on " & Date & " at " & Time & " by BlueDevilFan's script."
            .Save
        End With
    End If
    Set olkContact = Nothing
    Set olkContacts = Nothing
    Set olkReply = Nothing
    Set olkRecip = Nothing

 End Sub

Hazırlayan : Özgür Özocak