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