1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94
| Private Sub UserForm_Initialize()
'Instance des Objets
Set olNS = olApp.GetNamespace("MAPI")
Set olDefContactFldr = olNS.GetDefaultFolder _
(olFolderContacts)
On Error Resume Next
Set bcmRootFldr = olNS.Session.Folders _
("Gestionnaire de contacts professionnels")
On Error GoTo 0
'Permet le choix entre les contacts personnels et le bcm
With cboSessionList
.Clear
.AddItem (olDefContactFldr.Name)
If bcmRootFldr Is Nothing Then
Else
.AddItem (bcmRootFldr.Name)
End If
End With
cboSessionList.ListIndex = 1
'Définit les entêtes de colonnes
With lstContacts
With .ColumnHeaders
'Supprime les anciens entêtes
.Clear
'Ajout des colonnes
.Add Text:="Nom", Width:=70
.Add Text:="Prénom", Width:=70
.Add Text:="Entreprise", Width:=80
.Add Text:="E-mail", Width:=120
.Add Text:="Tél bureau", Width:=80
.Add Text:="Fax bureau", Width:=80
.Add Text:="Tél mobile", Width:=80
.Add Text:="Rue", Width:=90
.Add Text:="CP", Width:=30
.Add Text:="Ville", Width:=50
.Add Text:="Catégorie", Width:=70
End With
.View = lvwReport 'affichage en mode Rapport
.Gridlines = True 'affichage d'un quadrillage
.FullRowSelect = True 'Sélection des lignes complètes
.Sorted = True 'tri les contact selon la 1ère colonne
.AllowColumnReorder = False 'ne permet pas de réorganiser les colonnes
End With
'La première ligne étant toujours séléctionnée par défaut,
'on la déséléctionne par l'instruction suivante
Set lstContacts.SelectedItem = Nothing
Set olFolders = Nothing
Set olApp = Nothing
Set olNS = Nothing
End Sub
Private Sub cboSessionList_Change()
Dim objChosenFldr As Outlook.Items
Dim i As Integer
Dim x As Integer
Dim y As Integer
If cboSessionList = olDefContactFldr.Name Then
Set objChosenFldr = olDefContactFldr.Items
ElseIf cboSessionList = bcmRootFldr.Name Then
Set objChosenFldr = bcmRootFldr.Folders("Contacts professionnels").Items
End If
lstContacts.ListItems.Clear 'purge de la liste
lstContacts.Sorted = False 'désactiver le tri avant l'ajout des contacts pour éviter les problèmes!!!
lstContacts.Visible = False
i = 1
For Each objContact In objChosenFldr
With lstContacts
.ListItems.Add Text:=objContact.LastName
.ListItems(i).ListSubItems.Add Text:=objContact.FirstName
.ListItems(i).ListSubItems.Add Text:=objContact.CompanyName
.ListItems(i).ListSubItems.Add Text:=objContact.Email1Address
.ListItems(i).ListSubItems.Add Text:=objContact.BusinessTelephoneNumber
.ListItems(i).ListSubItems.Add Text:=objContact.BusinessFaxNumber
.ListItems(i).ListSubItems.Add Text:=objContact.MobileTelephoneNumber
.ListItems(i).ListSubItems.Add Text:=objContact.BusinessAddressStreet
.ListItems(i).ListSubItems.Add Text:=objContact.BusinessAddressPostalCode
.ListItems(i).ListSubItems.Add Text:=objContact.BusinessAddressCity
.ListItems(i).ListSubItems.Add Text:=objContact.Categories
End With
i = i + 1
Next objContact
lstContacts.Visible = True
Set objChosenFldr = Nothing
End Sub |
Partager