Simple petit programme faite rapidement pour me permettre de trier mes contacts extrait d'un compte à un autre. Le trieur de Hotmail est bien plus pratique, mais très peu si on veut garder ces contacts sur ce compte...
Bref pour l'utiliser, vous vous devez(!!!) d'exporter vos contacts à partir d'HOTMAIL pour l'importer dans mon programme.
Source / Exemple :
Imports System.IO
Imports System.Text.RegularExpressions
Public Class frmMain
Dim TempListBox As ListBox
Dim PremierFichier As Boolean = True
Dim NomFicherImporter As String
Const constPositionEmail1 As Integer = 46
Const constPositionEmail2 As Integer = 49
Private Sub btnChoisirFichier_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnChoisirFichier.Click
'Selection de fichier :
'Variables
Dim poursuivre As Boolean = True
If (PremierFichier = True) Then
PremierFichier = False
Else
Dim reply As DialogResult = MessageBox.Show("La liste de vos contacts triées va être vidé, voulez-vous continuez?", "Vidange des listes", _
MessageBoxButtons.YesNo, MessageBoxIcon.Question, MessageBoxDefaultButton.Button1)
If reply = DialogResult.Yes Then
lsContactImport.Items.Clear()
lsok.Items.Clear()
lsrefuser.Items.Clear()
lsretri.Items.Clear()
Else
poursuivre = False
End If
End If
If (poursuivre = True) Then
Dim strUrlFichier As String = String.Empty
'Ouverture de la fenêtre pour choisir un fichier
Dim OpenFD As Integer = ofdFichier.ShowDialog()
'Si un fichier est sélectionné
If OpenFD <> DialogResult.Cancel Then
strUrlFichier = ofdFichier.FileName
If (ofdFichier.FileName.EndsWith(".csv") Or ofdFichier.FileName.EndsWith(".txt")) Then
If (strUrlFichier IsNot Nothing) Then
tbFicher.Text = strUrlFichier
lireContact(strUrlFichier)
NomFicherImporter = ""
Dim fnPeices() As String = ofdFichier.SafeFileName.ToString.Split(".")
Dim i As Integer = 0
Do While i < fnPeices.Count - 1
NomFicherImporter &= fnPeices(i) & "."
i += 1
Loop
NomFicherImporter = NomFicherImporter.Substring(0, NomFicherImporter.Length - 1)
End If
Else
MsgBox("Format de fichier invalide")
End If
End If
End If
End Sub
Sub lireContact(ByVal fichier As String)
Try 'Ouverture de fichier = try...
Dim stFichier As New StreamReader(fichier, System.Text.Encoding.ASCII) 'Flux pour lire le fichier
Dim strSplitLine() As String
Dim strLigne As String
stFichier.BaseStream.Seek(0, SeekOrigin.Begin)
stFichier.ReadLine() 'Simplement pour sauter la première ligne qui contient le titre des colones
While stFichier.Peek() > -1
Dim rep As String = stFichier.Peek
strLigne = stFichier.ReadLine()
strSplitLine = strLigne.Split(";")
If (strSplitLine(constPositionEmail1) <> "") Then
strSplitLine(constPositionEmail1) = strSplitLine(constPositionEmail1).Substring(1, (strSplitLine(constPositionEmail1).ToString.Length - 2))
End If
If (strSplitLine(constPositionEmail2) <> "") Then
strSplitLine(constPositionEmail2) = strSplitLine(constPositionEmail2).Substring(1, (strSplitLine(constPositionEmail2).ToString.Length - 2))
End If
If (IsEmail(strSplitLine(constPositionEmail1))) Then
lsContactImport.Items.Add(strSplitLine(constPositionEmail1))
Else
If (IsEmail(strSplitLine(constPositionEmail2))) Then
lsContactImport.Items.Add(strSplitLine(constPositionEmail2))
End If
End If
End While
stFichier.Close()
Catch ex As Exception
MsgBox("Impossible de charger ce fichier!")
End Try
End Sub
Function IsEmail(ByVal email As String) As Boolean
Static emailExpression As New Regex("^[_a-z0-9-]+(.[a-z0-9-]+)@[a-z0-9-]+(.[a-z0-9-]+)*(.[a-z]{2,4})$")
Return emailExpression.IsMatch(email)
End Function
Private Sub CacheIcon(ByVal lequel As String)
Dim quel As Integer = CInt(lequel)
pbOk.Enabled = True
pbOk.Image = My.Resources.ok
pbPasOk.Enabled = True
pbPasOk.Image = My.Resources.pasok
pbTri.Enabled = True
pbTri.Image = My.Resources.tri
If (quel = 0) Then
pbOk.Enabled = False
pbOk.Image = My.Resources.okgris
End If
If (quel = 1) Then
pbPasOk.Enabled = False
pbPasOk.Image = My.Resources.pasokgris
End If
If (quel = 2) Then
pbTri.Enabled = False
pbTri.Image = My.Resources.trigris
End If
End Sub
Private Sub pbOk_MouseEnter(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles pbTri.MouseEnter, pbPasOk.MouseEnter, pbOk.MouseEnter
Dim TempPictureBox As PictureBox
TempPictureBox = DirectCast(sender, PictureBox)
TempPictureBox.BorderStyle = BorderStyle.FixedSingle
End Sub
Private Sub pbOk_MouseLeave(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles pbTri.MouseLeave, pbPasOk.MouseLeave, pbOk.MouseLeave
Dim TempPictureBox As PictureBox
TempPictureBox = DirectCast(sender, PictureBox)
TempPictureBox.BorderStyle = BorderStyle.None
End Sub
Private Sub pbOk_MouseDown(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles pbTri.MouseDown, pbPasOk.MouseDown, pbOk.MouseDown
Dim TempPictureBox As PictureBox
TempPictureBox = DirectCast(sender, PictureBox)
TempPictureBox.BorderStyle = BorderStyle.Fixed3D
End Sub
Private Sub pbOk_MouseUp(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles pbTri.MouseUp, pbPasOk.MouseUp, pbOk.MouseUp
Dim TempPictureBox As PictureBox
TempPictureBox = DirectCast(sender, PictureBox)
TempPictureBox.BorderStyle = BorderStyle.FixedSingle
If (TempPictureBox.Tag = 0) Then
ContactOk()
End If
If (TempPictureBox.Tag = 1) Then
ContactPasOk()
End If
If (TempPictureBox.Tag = 2) Then
ContactRetri()
End If
End Sub
Private Sub frmMain_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
TempListBox = lsok
End Sub
Private Sub lsretri_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles lsretri.SelectedIndexChanged, lsrefuser.SelectedIndexChanged, lsok.SelectedIndexChanged, lsContactImport.SelectedIndexChanged
If (TempListBox IsNot DirectCast(sender, ListBox)) Then
If (TempListBox.SelectedItem <> "") Then
TempListBox.SelectedIndex = -1
End If
TempListBox = DirectCast(sender, ListBox)
CacheIcon(TempListBox.Tag)
End If
End Sub
Private Sub ContactOk()
If (TempListBox.SelectedItem <> "") Then
lsok.Items.Add(TempListBox.SelectedItem)
TempListBox.Items.RemoveAt(TempListBox.SelectedIndex)
If (TempListBox.Items.Count > 0) Then
TempListBox.SelectedIndex = 0
End If
End If
End Sub
Private Sub ContactPasOk()
If (TempListBox.SelectedItem <> "") Then
lsrefuser.Items.Add(TempListBox.SelectedItem)
TempListBox.Items.RemoveAt(TempListBox.SelectedIndex)
If (TempListBox.Items.Count > 0) Then
TempListBox.SelectedIndex = 0
End If
End If
End Sub
Private Sub ContactRetri()
If (TempListBox.SelectedItem <> "") Then
lsretri.Items.Add(TempListBox.SelectedItem)
TempListBox.Items.RemoveAt(TempListBox.SelectedIndex)
If (TempListBox.Items.Count > 0) Then
TempListBox.SelectedIndex = 0
End If
End If
End Sub
Private Sub btnretri_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnretri.Click, btnrefuser.Click, btnok.Click
Dim TempBouton As Button
TempBouton = DirectCast(sender, Button)
EnregistrerListe(CInt(TempBouton.Tag))
End Sub
Private Sub EnregistrerListe(ByVal lequel As Integer)
Dim typenom As String = ""
If (lequel = 0) Then
typenom = "ContactsAccepte"
End If
If (lequel = 1) Then
typenom = "ContactsRefuse"
End If
If (lequel = 2) Then
typenom = "ContactsARetrier"
End If
Dim extension As String = DateTime.Now.ToString.Replace(" ", "-")
extension = extension.Replace(":", ".")
Dim Dossier As String = System.Environment.GetFolderPath(System.Environment.SpecialFolder.MyDocuments) + "\listeemail\" + typenom
Dim NomFichier As String = System.Environment.GetFolderPath(System.Environment.SpecialFolder.MyDocuments) + "\listeemail\" + typenom + "\" + NomFicherImporter + "-" + extension + ".txt"
If (Not System.IO.Directory.Exists(Dossier)) Then
System.IO.Directory.CreateDirectory(Dossier)
End If
Dim MonFlux As New System.IO.FileStream(NomFichier, FileMode.OpenOrCreate, FileAccess.ReadWrite, FileShare.None)
Dim objWriter As New StreamWriter(MonFlux)
objWriter.WriteLine("""Title"";""First Name"";""Middle Name"";""Last Name"";""Suffix"";""Company"";""Department"";""Job Title"";""Business Street"";""Business City"";""Business State"";""Business Postal Code"";""Business Country"";""Home Street"";""Home City"";""Home State"";""Home Postal Code"";""Home Country"";""Business Fax"";""Business Phone"";""Business Phone 2"";""Callback"";""Car Phone"";""Company Main Phone"";""Home Fax"";""Home Phone"";""Home Phone 2"";""ISDN"";""Mobile Phone"";""Other Fax"";""Other Phone"";""Pager"";""Primary Phone"";""Radio Phone"";""TTY/TDD Phone"";""Telex"";""Account"";""Anniversary"";""Assistant's Name"";""Billing Information"";""Birthday"";""Business Address PO Box"";""Categories"";""Children"";""Company Yomi"";""Directory Server"";""E-mail Address"";""E-mail Type"";""E-mail Display Name"";""E-mail 2 Address"";""E-mail 2 Type"";""E-mail 2 Display Name"";""E-mail 3 Address"";""E-mail 3 Type"";""E-mail 3 Display Name"";""Gender"";""Given Yomi"";""Government ID Number"";""Hobby"";""Home Address PO Box"";""Initials"";""Internet Free Busy"";""Keywords"";""Language"";""Location"";""Manager's Name"";""Mileage"";""Notes"";""Office Location"";""Organizational ID Number"";""Other Address PO Box"";""Priority"";""Private"";""Profession"";""Referred By"";""Sensitivity"";""Spouse"";""Surname Yomi"";""User 1"";""User 2"";""Web Page""")
If (lequel = 0) Then
For Each c In lsok.Items
If (c.ToString.Length > 1) Then
objWriter.WriteLine(";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;""" + c.ToString + """;""SMTP"";;""" + c.ToString + """;""SMTP"";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;")
End If
Next
End If
objWriter.Flush()
objWriter.Close()
MonFlux.Close()
MsgBox("Votre liste de contacts à été enregisté.")
Process.Start("notepad", NomFichier)
End Sub
End Class
Conclusion :
Programme très basic!
P.S. lieux d'enregistrement des fichiers est dans le dossier listeemail qui se trouve dans le repertoire Mes documents...
Ah oui dsl il manque de commentaire...
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.