Soyez le premier à donner votre avis sur cette source.
Vue 18 983 fois - Téléchargée 903 fois
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
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.