Sub LectureContacts()
Set olApp = CreateObject("Outlook.Application")
Set olns = olApp.GetNamespace("MAPI")
Set olfFolder = olns.GetDefaultFolder(10)
ligne = 2
On Error Resume Next ' contacts incomplets
For Each i In olfFolder.Items
Cells(ligne, 1) = i.FirstName
Cells(ligne, 2) = i.LastName
Cells(ligne, 3) = i.Email1Address
Cells(ligne, 4) = i.Categories
ligne = ligne + 1
Next i
On Error GoTo 0
[A1].Sort Key1:=[A1], Header:=xlYes
End Sub
Sub AjoutContact()
Set olApp = CreateObject("Outlook.Application")
Set olItem = olApp.CreateItem(2)
With olItem
.FirstName = "zzzzz"
.LastName = "zzzzz"
.Email1Address = "zzzzz@hotmail.com"
.HomeAddressCity = "Montigny"
.Categories = "Professionnel, Personnel"
.Save
End With
End Sub