Dim Tbl()
Private Sub UserForm_Initialize()
Dim Temp()
Set olApp = CreateObject("Outlook.Application")
Set olns = olApp.GetNamespace("MAPI")
Set olfFolder = olns.GetDefaultFolder(10)
n = 0
On Error Resume Next ' Contacts incomplets
For Each i In olfFolder.Items
ReDim Preserve Tbl(0 To 12, 0 To n)
'modif 0 To 12(Avant 0 to 3)et propriétés ListBox ColumnCount 10 et les largeurs des colonnes dans
'ColumnWidths
Tbl(0, n) = i.CompanyName
Tbl(1, n) = i.LastName & " " & i.FirstName
Tbl(2, n) = i.Title 'Titre M. - MM, etc
Tbl(3, n) = i.Categories
Tbl(4, n) = i.BusinessAddressStreet
Tbl(5, n) = i.BusinessAddressPostalCode ';i.BusinessAdressCity
Tbl(6, n) = i.BusinessAddressCity
Tbl(7, n) = i.BusinessAddressState '=Département
Tbl(8, n) = i.BusinessAddressCountry '=Pays
Tbl(9, n) = i.BusinessFaxNumber
Tbl(10, n) = i.Email1Address
Tbl(11, n) = i.MobileTelephoneNumber
'Tbl(7, n) = i.BusinessTelephoneNumber
'Tbl(8, n) = i.BusinessFaxNumber
'Tbl(9, n) = i.MobileTelephoneNumber
'Tbl(10, n) = i.Email1Address
'Tbl(11, n) = i.WebPage
n = n + 1
Next
On Error GoTo 0
Call triQ(Tbl, 0, n - 1)
Me.ListBox1.List = Application.Transpose(Tbl)
Set Mondico = CreateObject("Scripting.Dictionary")
Mondico.Add "(tous)", "(tous)"
For i = 0 To UBound(Tbl, 2)
Tmp = Split(Tbl(3, i), ";")
For k = LBound(Tmp) To UBound(Tmp)
If Not Mondico.Exists(Trim(Tmp(k))) Then Mondico.Add Trim(Tmp(k)), Trim(Tmp(k))
Next k
Next i
Me.ChoixCatégorie.List = Mondico.Items
Me.ChoixCatégorie = "(tous)"
End Sub
Sub triQ(a(), gauc, droi)
' Quick sort
ref = a(0, (gauc + droi) \ 2)
g = gauc: d = droi
Do
Do While a(0, g) < ref: g = g + 1: Loop
Do While ref < a(0, d): d = d - 1: Loop
If g <= d Then
Temp = a(0, g): a(0, g) = a(0, d): a(0, d) = Temp
Temp = a(1, g): a(1, g) = a(1, d): a(1, d) = Temp
Temp = a(2, g): a(2, g) = a(2, d): a(2, d) = Temp
Temp = a(3, g): a(3, g) = a(3, d): a(3, d) = Temp
Temp = a(4, g): a(4, g) = a(4, d): a(4, d) = Temp
Temp = a(5, g): a(5, g) = a(5, d): a(5, d) = Temp
Temp = a(6, g): a(6, g) = a(6, d): a(6, d) = Temp
Temp = a(7, g): a(7, g) = a(7, d): a(7, d) = Temp
Temp = a(8, g): a(8, g) = a(8, d): a(8, d) = Temp
Temp = a(9, g): a(9, g) = a(9, d): a(9, d) = Temp
Temp = a(10, g): a(10, g) = a(10, d): a(10, d) = Temp
Temp = a(11, g): a(11, g) = a(11, d): a(11, d) = Temp
g = g + 1: d = d - 1
End If
Loop While g <= d
If g < droi Then Call triQ(a, g, droi)
If gauc < d Then Call triQ(a, gauc, d)
End Sub
Private Sub ListBox1_Click()
On Error Resume Next
[L17] = ListBox1.Column(0) 'ENTREPRISE
[L18] = ListBox1.Column(2) & " " & ListBox1.Column(1) 'TITRE NOM ET PRENOM
[L19] = ListBox1.Column(4) 'ADRESSE
[L20] = ListBox1.Column(5) & " " & ListBox1.Column(6) 'CP VILLE
[L21] = ListBox1.Column(7) & " - " & ListBox1.Column(8) 'CANTON - PAYS
[P18] = " F: " & ListBox1.Column(9) 'FAX
[P19] = " E: " & ListBox1.Column(10) 'EMAIL
[P20] = " N: " & ListBox1.Column(11) 'NATEL
End Sub
Private Sub ChoixCatégorie_Change()
Dim Temp()
If Me.ChoixCatégorie = "(tous)" Then
Me.ListBox1.List = Application.Transpose(Tbl)
Else
j = 0
For i = 0 To UBound(Tbl, 2)
If InStr(Tbl(3, i), Me.ChoixCatégorie) > 0 Then
ReDim Preserve Temp(0 To 12, 0 To j)
Temp(0, j) = Tbl(0, i): Temp(1, j) = Tbl(1, i)
Temp(2, j) = Tbl(2, i): Temp(3, j) = Tbl(3, i)
Temp(4, j) = Tbl(4, i): Temp(5, j) = Tbl(5, i)
Temp(6, j) = Tbl(6, i): Temp(7, j) = Tbl(7, i)
Temp(8, j) = Tbl(8, i): Temp(9, j) = Tbl(9, i)
Temp(10, j) = Tbl(10, i): Temp(11, j) = Tbl(11, i)
j = j + 1
End If
Next i
If UBound(Temp, 2) > 0 Then
Me.ListBox1.List = Application.Transpose(Temp)
Else
ReDim Preserve Temp(0 To 12, 0 To j)
Temp(0, j) = "": Temp(1, j) = "": Temp(2, j) = "": Temp(3, j) = "": Temp(4, j) = ""
Temp(5, j) = "": Temp(6, j) = "": Temp(7, j) = "": Temp(8, j) = "": Temp(9, j) = ""
Temp(10, j) = "": Temp(11, j) = ""
Me.ListBox1.List = Application.Transpose(Temp)
End If
End If
End Sub
Private Sub ChoixEntreprise_Change()
Dim Temp()
If Me.ChoixEntreprise = "(tous)" Then
Me.ListBox1.List = Application.Transpose(Tbl)
Else
j = 0
For i = 0 To UBound(Tbl, 2) 'changer 2 par 0
If InStr(Tbl(1, i), Me.ChoixEntreprise) > 0 Then 'changer 3 par 0
ReDim Preserve Temp(0 To 12, 0 To j)
Temp(0, j) = Tbl(0, i): Temp(1, j) = Tbl(1, i)
Temp(2, j) = Tbl(2, i): Temp(3, j) = Tbl(3, i)
Temp(4, j) = Tbl(4, i): Temp(5, j) = Tbl(5, i)
Temp(6, j) = Tbl(6, i): Temp(7, j) = Tbl(7, i)
Temp(8, j) = Tbl(8, i): Temp(9, j) = Tbl(9, i)
Temp(10, j) = Tbl(10, i): Temp(11, j) = Tbl(11, i)
j = j + 1
End If
Next i
If UBound(Temp, 1) > 0 Then 'changer 2 par 0
Me.ListBox1.List = Application.Transpose(Temp)
Else
ReDim Preserve Temp(0 To 12, 0 To j)
Temp(0, j) = "": Temp(1, j) = "": Temp(2, j) = "": Temp(3, j) = "": Temp(4, j) = ""
Temp(5, j) = "": Temp(6, j) = "": Temp(7, j) = "": Temp(8, j) = "": Temp(9, j) = ""
Temp(10, j) = "": Temp(11, j) = ""
Me.ListBox1.List = Application.Transpose(Temp)
End If
End If
End Sub
