1. Accueil
  2. Visual Basic / VB.NET
  3. Sources Visual Basic / VB.NET
  4. Sources Divers
  5. Carnet d'adresse outlook vers excel (office 2003) en vs 2005

Carnet d'adresse outlook vers excel (office 2003) en vs 2005

Soyez le premier à donner votre avis sur cette source.

Vue 18 983 fois - Téléchargée 903 fois

Télécharger le projet
Commenter

Description

Cette application utilise les assemblys PIA Office 2003, Microsoft.Office.Interop.Outlook et Excel.
Le formulaire affiche les adresses mails contenues dans Outlook(Nom,Adresse mail,téléphone Home) dans un DataGridView, ensuite vous pouvez les transférer vers un fichier Excel formaté sur le bureau.
A la fermeture de l'application, les instances crées sont supprimées, sauf celle d'Outlook si elle était en cours d'utilisation.

Source / Exemple : 


Imports Outlook = Microsoft.Office.Interop.Outlook
Imports Excel = Microsoft.Office.Interop.Excel
Imports System.Windows.Forms
Imports System.Drawing

Public Class OutlookAdresses
    Private m_ExcelApp As Excel.Application
    Private m_OutlookApp As Outlook.Application
    Private m_MapiContact As Outlook.MAPIFolder
    Private processes() As Process
    Private procName As String = "Outlook"
    Private m_OutlookRun As Boolean
    Private m_OutlookId As Integer
    Private m_OutlookBefore(), m_OutlookAfter() As Process
    Private m_ExcelBefore(), m_ExcelAfter() As Process
    Private m_ExcelId As Integer
    Private m_WorkBook As Excel.Workbook
    Private m_WorkSheet As Excel.Worksheet
    Private m_NbTxt As Integer = 1
    Private m_rg As Excel.Range

    Private Sub ButLancer_Click(ByVal sender As System.Object, _
                        ByVal e As System.EventArgs) Handles ButLancer.Click
        If m_OutlookApp Is Nothing Then

            Try
                'si Outlook est en cours d'éxécution on utilise son instance
                Me.m_OutlookApp = System.Runtime.InteropServices.Marshal.GetActiveObject("Outloo.Application")
                Me.m_OutlookRun = True
            Catch ex As Exception
                'création d'une instance Outlook et renvoi de son ID de process pour Kill()
                m_OutlookId = CreateInstanceOutlook()
            End Try
            '/ Récupération du répertoire contact de Outlook.
            Me.m_MapiContact = m_OutlookApp.GetNamespace("MAPI"). _
            GetDefaultFolder(Outlook.OlDefaultFolders.olFolderContacts)
        End If
        For Each Ci As Outlook.ContactItem In m_MapiContact.Items
            'Dim ci As Outlook.ContactItem = DirectCast(Contact, Outlook.ContactItem)
            Dim dt As String() = {Ci.FullName, Ci.Email1Address, Ci.HomeTelephoneNumber}
            For i As Integer = 0 To dt.Length - 1
                If IsNothing(dt(i)).ToString Then dt(i) = "/"
            Next
            Me.DataGridView1.Rows.Add(dt)
        Next
        Me.ButExcel.Enabled = True
    End Sub

    Private Sub OutlookAdresses_FormClosed(ByVal sender As Object, _
            ByVal e As System.Windows.Forms.FormClosedEventArgs) Handles Me.FormClosed
        '/ si pas d'instances ouvertes, on quitte
        If (m_ExcelId = 0) And (m_OutlookId = 0) Then Exit Sub
        '/ si des instances Outlook ou Excel ont été crées,on les détruit
        If m_ExcelId Then   'm_ExcelId # 0 / 0=False
            m_ExcelApp = Nothing
            Process.GetProcessById(m_ExcelId).Kill()
        End If
        If m_OutlookId Then     ' m_IdApp # 0 / 0=False
            '/ si Outlook était ouvert, on laisse l'application en fonctionnement
            '/ sinon on détruit l'instance
            If m_OutlookRun Then
                'm_OutlookApp.Quit()
                m_MapiContact = Nothing
                m_OutlookApp = Nothing
            Else
                System.Runtime.InteropServices.Marshal.ReleaseComObject(m_MapiContact)
                System.Runtime.InteropServices.Marshal.ReleaseComObject(m_OutlookApp)
                Process.GetProcessById(m_OutlookId).Kill()
                Exit Sub
            End If
        End If
    End Sub

    Private Sub ButQuit_Click(ByVal sender As System.Object, _
                            ByVal e As System.EventArgs) Handles ButQuit.Click
        Me.Close()
    End Sub

    Function CreateInstanceOutlook() As Integer
        'Détection des instance éventuelles Outlook
        Me.m_OutlookBefore = Process.GetProcessesByName(procName)
        'Instance oulook application
        Me.m_OutlookApp = New Outlook.Application
        'Détection des Instances Outlook
        Me.m_OutlookAfter = Process.GetProcessesByName(procName)
        If m_OutlookBefore.Length = 0 Then
            CreateInstanceOutlook = m_OutlookAfter(0).Id
        Else
            For Each proc As Process In m_OutlookAfter
                For i As Integer = 0 To m_OutlookBefore.Length - 1
                    If Not proc.Id = m_OutlookBefore(i).Id Then
                        CreateInstanceOutlook = proc.Id
                    End If
                Next
            Next
        End If
    End Function
    Function CreateInstanceExcel() As Integer
        Me.m_ExcelBefore = Process.GetProcessesByName("Excel")
        Me.m_ExcelApp = New Excel.Application
        Me.m_ExcelAfter = Process.GetProcessesByName("Excel")
        If m_ExcelBefore.Length = 0 Then
            CreateInstanceExcel = m_ExcelAfter(0).Id
        Else
            For Each proc As Process In Me.m_ExcelAfter
                For i As Integer = 0 To Me.m_ExcelBefore.Length - 1
                    If Not proc.Id = Me.m_ExcelBefore(i).Id Then
                        CreateInstanceExcel = proc.Id
                    End If
                Next
            Next
        End If

    End Function

    Private Sub ButExcel_Click(ByVal sender As System.Object, _
                        ByVal e As System.EventArgs) Handles ButExcel.Click
        '/ test si le fichier Excel a déjà été généré(reclic sur bouton "Vers Excel")
        If m_ExcelId Then
            m_ExcelApp = Nothing
            Process.GetProcessById(m_ExcelId).Kill()
        End If
        If m_ExcelApp Is Nothing Then
            '/creer une instance Excel et renvoi du Process.id
            m_ExcelId = CreateInstanceExcel()
            '/ si pas de fichier, ajout d'un WorkBook et enregistrement.
            Me.m_ExcelApp.DisplayAlerts = False
            Me.m_WorkBook = Me.m_ExcelApp.Workbooks.Add(Type.Missing)
            Me.m_WorkBook.SaveAs("C:\Documents and Settings\" & _
                    Environment.UserName & "\Bureau\Adresses Mails.xls", _
            Type.Missing, Type.Missing, Type.Missing, Type.Missing, Type.Missing, _
            Excel.XlSaveAsAccessMode.xlNoChange, Type.Missing, Type.Missing, _
            Type.Missing, Type.Missing)
        End If

        InitFichierExcel()
        EcrireFichierExcel()
        MsgBox("Le fichier Excel a été placé sur le Bureau" & _
           vbCrLf & "Après lecture supprimer ce fichier")
        Me.m_ExcelApp.Visible = True
        Me.Visible = True

    End Sub
    Private Sub EcrireFichierExcel()
        Me.m_WorkSheet = Me.m_WorkBook.ActiveSheet
        With Me.m_WorkSheet

            For i As Integer = 0 To Me.DataGridView1.RowCount - 1
                .Cells(2 + i, 1).value = Me.DataGridView1.Rows(i).Cells(0).Value.ToString
                .Cells(2 + i, 2).value = Me.DataGridView1.Rows(i).Cells(1).Value.ToString
                .Cells(2 + i, 3).value = Me.DataGridView1.Rows(i).Cells(2).Value.ToString
            Next
        End With
        '/ Suppression du message Excel si le fichier existe déjà /
        Me.m_ExcelApp.DisplayAlerts = False
        '/ on enregistre le fichier sur le bureau /
        Me.m_WorkBook.SaveAs("C:\Documents and Settings\" & _
                    Environment.UserName & "\Bureau\Adresses Mails.xls", _
                    Type.Missing, Type.Missing, Type.Missing, Type.Missing, Type.Missing, _
                    Excel.XlSaveAsAccessMode.xlNoChange, Type.Missing, Type.Missing, _
                    Type.Missing, Type.Missing)
    End Sub

#Region "Mise en forme fichier Excel barre de titre et couleur cellules"
    Sub InitFichierExcel()
        Dim rg As String = "A1:C1"
        Me.m_rg = Me.m_WorkBook.ActiveSheet.Range(rg)
        '/ Mise en forme de la ligne de titres
        Dim bord As Excel.XlBordersIndex() = {Excel.XlBordersIndex.xlEdgeBottom, _
        Excel.XlBordersIndex.xlEdgeLeft, Excel.XlBordersIndex.xlEdgeRight, _
        Excel.XlBordersIndex.xlEdgeTop, Excel.XlBordersIndex.xlInsideVertical}
        With m_rg
            For i As Integer = 0 To bord.Length - 1
                With .Borders(bord(i))
                    .LineStyle = Excel.XlLineStyle.xlContinuous
                    .Weight = Excel.XlBorderWeight.xlThick
                    .ColorIndex = 54
                End With
            Next
            .Interior.ColorIndex = 15
            .VerticalAlignment = Excel.XlVAlign.xlVAlignCenter
            .HorizontalAlignment = Excel.XlHAlign.xlHAlignCenter
            .Font.Size = 14
            .Font.ColorIndex = 2
        End With
        Me.m_WorkBook.ActiveSheet.Range("A1").Value = "Nom"
        Me.m_WorkBook.ActiveSheet.columns("A:A").columnwidth = 30
        Me.m_WorkBook.ActiveSheet.Range("B1").Value = "Adresse eMail"
        Me.m_WorkBook.ActiveSheet.columns("B:B").columnwidth = 40
        Me.m_WorkBook.ActiveSheet.Range("C1").Value = "Téléphone"
        Me.m_WorkBook.ActiveSheet.columns("C:C").columnwidth = 20
        '/ Fin de Mise en forme de la ligne de titres
        rg = "A2:C" & Me.DataGridView1.RowCount + 1
        Me.m_rg = Me.m_WorkBook.ActiveSheet.Range(rg)
        For Each c As Object In Me.m_rg.Cells
            For i As Integer = 0 To 2
                With c.borders(bord(i))
                    .LineStyle = Excel.XlLineStyle.xlContinuous
                    .Weight = Excel.XlBorderWeight.xlThin
                    .ColorIndex = 54
                End With
            Next
            c.font.size = 12
        Next
        '/ fond de cellule pour chaque colonne
        Dim nbLig As Integer = Me.DataGridView1.RowCount - 1
        For i As Integer = 0 To nbLig
            With Me.m_rg
                .Cells(1 + i, 1).interior.colorindex = 36
                .Cells(1 + i, 2).interior.colorindex = 35
                .Cells(1 + i, 3).interior.colorindex = 40
            End With
        Next
    End Sub
#End Region

#Region "cette procédure était prévue pour afficher le Nom et l'Adresse eMail"
    '/ dans des TextBox creés dynamiquement."
    Private Sub Buttxt_Click(ByVal sender As System.Object, _
                            ByVal e As System.EventArgs)
        Dim m_decalV As Integer = 30
        Dim Txtnom As New TextBox
        Txtnom.Name = "TextBoxNom" & CType(m_NbTxt, String)
        Txtnom.Location = New Point(50, 50 + m_decalV * m_NbTxt)
        Txtnom.Size = New Size(140, 20)
        Me.Controls.Add(Txtnom)
        Dim TxtMail As New TextBox
        TxtMail.Name = "TextBoxMail" & CType(m_NbTxt, String)
        TxtMail.Location = New Point(200, 50 + m_decalV * m_NbTxt)
        TxtMail.Size = New Size(250, 20)
        Me.Controls.Add(TxtMail)
        m_NbTxt += 1
        Dim T As String = ""
        For Each c As Control In Me.Controls
            If TypeOf c Is TextBox Then
                T += c.Name & vbCrLf
            End If
        Next
        MsgBox(T)
    End Sub
#End Region
End Class

Conclusion :


La collection Outlook.contact.Item permet d'étendre les fonctionnalités en ajoutant les différentes propriétés (Adresse domicile, téléphone bureau, téléphone mobile etc...).
Fonctionnement correct aves Office 2003, je n'ai pas la possibilité de tester aves d'autres versions.

Lien vers la mise en oeuvre des assemblys Office :
http://msdn2.microsoft.com/fr-fr/library/kh3965hw(VS.80).aspx
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.