LISTE TÉLÉPHONIQUE VIA ACTIVE DIRECTORY

Imports System.Reflection
Imports System.DirectoryServices

Module Module1

    Sub Main()

        '================================================================================================================
        ' LISTE TELEPHONIQUE
        '
        ' auteur: Johan Tanner
        ' Language: Visual Basic .NET
        '================================================================================================================
        Dim Ldap As DirectoryEntry = New DirectoryEntry("LDAP://NOMDUSERVEUR", "USERNAME", "PASSWORD")'Connexion au serveur Active directory
        Dim searcher As DirectorySearcher = New DirectorySearcher(Ldap)
        Dim DirEntry As DirectoryEntry
        Dim excel As New Excel.Application
        Dim wb As Excel.Workbook
        Dim ws As Excel.Worksheet
        Dim Li As Long

        searcher.Filter = "(objectClass=user)"
        excel.Visible = True 'la fenêtre excel est visible 
        wb = excel.Workbooks.Add(1) 'on ouvre un classeur dans excel
        ws = wb.Worksheets(1) 'on ouvre une feuille dans le classeur excel

        wb.Sheets("Feuil1").Select() 'on séléectionne la feuille nommé "Feuil1"
        wb.Sheets("Feuil1").Name = "XXX" 'on renomme la feuil1 (XXX étant le nom que vous pouvez modifier à volonté)

        Li = 4 'on assigne la valeur de 4 à Li
        For Each result As SearchResult In searcher.FindAll

            ' On récupère l'entrée trouvée lors de la recherche
            DirEntry = result.GetDirectoryEntry
            Dim a = DirEntry.Properties("displayName").Value 'on relève le nom et prénom
            Dim b = DirEntry.Properties("TelephoneNumber").Value 'on relève le numéro de téléphone
            Dim c = DirEntry.Properties("physicalDeliveryOfficeName").Value 'on relève le bureau
            Dim d = DirEntry.Properties("initials").Value 'on relève les initiales

            If c = "XXX" Then ' Si le champ Office(bureau) contient "XXX" (XXX étant la donnée du champ Office(bureau) dans active directory. Si un utilisateur n'as pas XXX dans le champs Offie, il ne sera pas pris. Ceci est modifiable bien sûr)

                ws.Range("A" & Li).Value = a 'Ecriture de la valeur de a dans la cellule
                ws.Range("A" & Li, "B" & Li).MergeCells = True 'fusion entre la cellule Ax et Bx
                ws.Range("A" & Li, "B" & Li).Borders.LineStyle = 1 'ajout d'une bordure à la cellule

                ws.Range("C" & Li).Value = d 'Ecriture de la valeur de d dans la cellule
                ws.Range("C" & Li, "D" & Li).MergeCells = True 'fusion entre la cellule Cx et Dx
                ws.Range("C" & Li, "D" & Li).Borders.LineStyle = 1 'ajout d'une bordure à la cellule

                ws.Range("E" & (Li)).Value = b 'Ecriture de la valeur de b dans la cellule
                ws.Range("E" & (Li), "F" & (Li)).MergeCells = True 'fusion entre la cellule Ex et Fx
                ws.Range("E" & Li, "F" & Li).Borders.LineStyle = 1 'ajout d'une bordure à la cellule

                Li = Li + 1 'on adition 1 à la valeur existante de Li

            End If

        Next

        '================================================================================================================
        ' PARTIE MISE EN PAGE DU FICHIER EXCEL
        '================================================================================================================

        ws.Range("A" & Li, "B" & Li).MergeCells = True 'fusion entra la cellule Ax et Bx
        ws.Range("C" & Li, "D" & Li).MergeCells = True 'fusion entra la cellule Cx et Dx
        ws.Range("E" & (Li), "F" & (Li)).MergeCells = True 'fusion entra la cellule Ex et Fx

        ws.Range("A4:F" & Li).Sort(Key1:=ws.Range("A4"), Order1:=Global.Excel.XlSortOrder.xlAscending, Header:=Global.Excel.XlYesNoGuess.xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=Global.Excel.XlSortOrientation.xlSortColumns) 'Tri des données dans ordre alphabétique en sélectionnant les 3 colonnes

        ws.Range("A1").Font.Bold = True 'Texte en gras
        ws.Range("A1").Font.Size = 10 'Taille du texte
        ws.Range("A1").Value = "NOM DE L'ENTREPRISE" 'Texte affiché
        ws.Range("A1", "G1").MergeCells = True 'fusion des cellule A1 et G1
        ws.Range("A1", "G1").Borders.LineStyle = 12 'bordure de la cellule (12 étant un style, 1 = style de base)

        ws.Range("A2").Value = "Tél. direct : 058 534" 'Texte affiché
        ws.Range("A2", "G2").MergeCells = True 'fusion entre la cellule A2 et G2

        ws.Range("A3").Value = "Nom et Prénom" 'Texte affiché
        ws.Range("A3").Font.Bold = True 'Texte en gras
        ws.Range("A3", "B3").MergeCells = True 'fusion entre la cellule A3 et B3
        ws.Range("A3", "B3").Borders.LineStyle = 1 'Bordure de la cellule (style standard)

        ws.Range("C3").Value = "Visa" 'Texte affiché
        ws.Range("C3").Font.Bold = True 'Texte en gras
        ws.Range("C3", "D3").MergeCells = True 'fusion entre la cellule C3 et D3
        ws.Range("C3", "D3").Borders.LineStyle = 1 'Bordure de la cellule (style standard)

        ws.Range("E3").Value = "Téléphone" 'Texte affiché
        ws.Range("E3").Font.Bold = True 'Texte en gras
        ws.Range("E3", "F3").MergeCells = True 'fusion entre la cellule E3 et F3
        ws.Range("E3", "F3").Borders.LineStyle = 1 'Bordure de la cellule (style standard)

        wb.SaveAs("C:\Liste_tel.xls") 'Enregistrement du fichier (A choix)

    End Sub

End Module

Télécharger le zip

26 juillet 2007 11:55:42 :

Correction de commentaire

27 juillet 2007 11:27:59 :

Ajout de mon projet dans un fichier ZIP

27 juillet 2007 11:31:36 :

Modification du code

27 juillet 2007 11:35:37 :

Modification de commentaires

27 juillet 2007 12:45:11 :

Ajout d'un commentaire de présentation du code

30 juillet 2007 14:03:20 :

Ajout du pres-requis dans la présentation de la source