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
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.