Dall'editor vba di outlook lancia questa macro
codice:
Sub crea_rubrica()
Dim diz
Dim cart As MAPIFolder
Set cart = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderSentMail)
Set diz = CreateObject("Scripting.Dictionary")
Dim mails() As String
Dim quante As Long, k As Long, j As Long, i As Long
Dim valore As Variant, chiave As Variant, dest As Variant
Dim contatto As ContactItem
quante = cart.Items.Count
k = 0
ReDim mails(quante)
For j = 1 To quante
Set messaggio = cart.Items(j)
mails(k) = messaggio.To
k = k + 1
Next j
For Each valore In mails
If Not diz.Exists(valore) Then
diz.Add valore, valore
End If
Next valore
quante = diz.Count - 1
ReDim arr(quante)
i = 0
For Each chiave In diz.Keys
arr(i) = chiave
i = i + 1
Next
For Each dest In arr
Set contatto = CreateItem(olContactItem)
With contatto
.Email1Address = dest
End With
contatto.Save
Next
Set diz = Nothing
End Sub