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