hazzelthorn Payday vador | Bien le bonjour !
J'expose mon problème, actuellement en BTS info en alternance je dois réaliser des PTI (des TP info à présenter devant un jury dans 1.5 ans) qui doivent remplir certaines conditions tel que :
-Gestion Client /Serveur
-Programmation Objet
-Suivi et évolution d'une appli
-Optimisation de l'appli
-etc etc... Dans ce but j'ai réalisé une application en VB.NET pour mon entreprise.
Cette application a pour le moment 2 buts : -Création d'un fichier excel avec la liste de tous les contacts clients de la boite en fonction de n paramètres
-Importation sous outlook 2003 de ces contacts dans un carnet de contacts situé dans DossierPublics/TouslesDossiersPublics/Toto par ex
Je viens vers vous pour que vous commentiez le code que j'ai réalisé (novice en VB j'ai du apprendre de zéro) et que si possible vous proposiez des pistes d'optimisation du code ou d'implémentations supplémentaires
NB : pour les implémentations supplémentaire mon Boss ma suggéré que la requête SQL exécutée en "Dur" dans mon code ce serait plus judicieux de la placer dans un fichier .INI lu par une fonction en VB.NET pour gérer justement plusieurs type de requêtes "importations de contacts"
Citation :
Création d'un fichier excel avec la liste de tous les contacts clients de la boite en fonction de n paramètres
|
Voilà le code complet commenté de partout :
Code :
- Imports Excel
- 'Module permettant d'importer le code VB6 qui est dans la premiere sub en .NET
- Module UpgradeSupport
- Friend OutlookApplication_definst As New Outlook.Application
- End Module
- Public Class Form2
- Private Sub Form2_Activated(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Activated
- ' dans un événement click de bouton par exemple
- Dim xlApp As New Excel.Application
- 'Si mon fichier existe je le delete
- If System.IO.File.Exists("C:\toto.xls" ) = True Then
- Kill("C:\toto.xls" )
- End If
- 'ajout d'une page et sélection
- Dim xsTransfert As Excel.Worksheet = xlApp.Workbooks.Add.ActiveSheet
- Try
- ' ici on crée la chaine de connexion
- ' (on se connecte à SQL Server dans notre exemple)
- With xsTransfert.QueryTables.Add(Connection:="ODBC;DRIVER=SQL Server;SERVER=NEPTUNE;APP=Microsoft® Query;DATABASE=absyss_test;Integrated Security=True", Destination:=xsTransfert.Range("A1" ))
- .CommandText = "SELECT CivDsc, CtcFstNamDsc, CtcNamDsc, CpyTrdNamDsc, CpyAddrStreet1Dsc, CpyAddrStreet2Dsc, CpyAddrZipDsc , CpyAddrExCde, CtcPhnNum, CtcFaxNum, CtcMailNum, DtyDsc as Titre1, CtcAbovDsc, CtcCellNum, CtcPrivNum, CpyAddrStreet2Dsc FROM p_cpy, p_cpyaddr, p_ctc, r_civ WHERE r_civ.CivInCde = p_ctc.CivInCde AND p_cpy.CpyInCde = p_cpyaddr.CpyInCde And p_cpyaddr.CpyAddrInCde = p_ctc.CpyAddrInCde AND p_ctc.ctcInCde >0 AND p_ctc.ctcNamDsc <> 'KIMWEB' AND p_ctc.ctcNamDsc <> 'VITO' AND p_ctc.ValidPnt <> 0 AND p_cpy.cpyStsInCde = 2 AND p_cpy.ValidPnt <> 0 AND p_cpy.CpyInCde <> 1000" ' ou requete SELECT"
- .Name = "feuil1"
- .FieldNames = True
- .RowNumbers = True
- .FillAdjacentFormulas = False
- .PreserveFormatting = True
- .RefreshOnFileOpen = False
- .BackgroundQuery = True
- .RefreshStyle = Excel.XlCellInsertionMode.xlOverwriteCells
- .SavePassword = False
- .SaveData = True
- .AdjustColumnWidth = True
- .RefreshPeriod = 0
- .PreserveColumnInfo = True
- .Refresh(BackgroundQuery:=False)
- End With
- ' affichage
- xlApp.Visible = False
- 'Gestion d'erreur
- Catch ex As Exception
- MsgBox("Va bosser ca marche pas !" )
- MessageBox.Show(ex.Message)
- End Try
- 'Sauvegarder le resultat de la requete SQL qui est copier dans mon fichier Excel
- xsTransfert.SaveAs("C:\toto.xls" )
- 'Pour enlever le message "voulez vous sauvegarder..."
- xlApp.DisplayAlerts = True
- 'Quit Excel
- xlApp.Quit()
- 'Libérer les ressources
- xlApp = Nothing
- xsTransfert = Nothing
- 'Detruire les process EXCEL.EXE
- GC.Collect()
- 'Appel de ma 2eme fonction
- Test()
- End Sub
- Sub Test()
- Dim Path As Object
- Dim ex As Object
- Dim oApp As Object
- Dim oCont As Outlook.ContactItem
- Dim lig As Short
- 'ici on va créer le dossier contact s'il n'existe pas
- On Error Resume Next
- Dim NS As Outlook.NameSpace
- Dim colCTSItems As Object
- Dim oemployee As Outlook.ContactItem
- NS = OutlookApplication_definst.Application.GetNamespace("MAPI" )
- 'On se place dans les DossierPublic/Tous les dossiers publics/Fichiers Clients KIMOCE que l'on delete s'il existe
- NS.GetDefaultFolder(Outlook.OlDefaultFolders.olPublicFoldersAllPublicFolders).Folders("Fichier Clients KIMOCE" ).Delete()
- 'On crée le "Fichier Client Kimoce en placant dans DossierPublic/Tous les dossiers publics
- colCTSItems = NS.GetDefaultFolder(Outlook.OlDefaultFolders.olPublicFoldersAllPublicFolders).Folders.Add("Fichier Clients KIMOCE", Outlook.OlDefaultFolders.olFolderContacts)
- ' Définie le dossier comme carnet d'adresse
- colCTSItems.ShowAsOutlookAB = True
- Err.Clear()
- On Error GoTo 0
- oApp = CreateObject("Excel.Application" )
- ex = oApp.Workbooks.Open("C:\toto.xls" )
- lig = 2
- Do Until ex.Sheets("Feuil1" ).Cells(lig, 2).Value = ""
- 'ici on créé un nouveau contact
- oCont = colCTSItems.Items.Add(Outlook.OlItemType.olContactItem)
- 'Nom
- oCont.FirstName = ex.Sheets("Feuil1" ).Cells(lig, 4).Value
- 'Prénom
- oCont.LastName = ex.Sheets("Feuil1" ).Cells(lig, 3).Value
- 'Adresse du Bureau
- oCont.BusinessAddressStreet = ex.Sheets("Feuil1" ).Cells(lig, 6).Value + Chr(13) + ex.Sheets("Feuil1" ).Cells(lig, 17).Value
- 'Nom Complet / Titre
- oCont.Title = ex.Sheets("Feuil1" ).Cells(lig, 2).Value
- 'Titre
- oCont.JobTitle = ex.Sheets("Feuil1" ).Cells(lig, 13).Value
- 'Adresse Bureau/ Ville
- oCont.BusinessAddressCity = ex.Sheets("Feuil1" ).Cells(lig, 9).Value
- 'Adresse Bureau/ Code postal
- oCont.BusinessAddressPostalCode = ex.Sheets("Feuil1" ).Cells(lig, 8).Value
- 'Société
- oCont.CompanyName = ex.Sheets("Feuil1" ).Cells(lig, 5).Value
- 'Ville Bureau
- 'oCont.BusinessAddressCountry = ex.Sheets("Feuil1" ).Cells(lig, 15).Value
- 'Classer Sous / Nom du manager
- oCont.ManagerName = ex.Sheets("Feuil1" ).Cells(lig, 14).Value
- 'Numero de telephone Bureau
- oCont.BusinessTelephoneNumber = ex.Sheets("Feuil1" ).Cells(lig, 10).Value
- 'Numero de telephone 2 pro
- 'oCont.Business2TelephoneNumber = ex.Sheets("Feuil1" ).Cells(lig, 33).Value
- 'Numero de telephone domicile
- 'oCont.HomeTelephoneNumber = ex.Sheets("Feuil1" ).Cells(lig, 38).Value
- 'Autre Numero de telephone
- 'oCont.OtherTelephoneNumber = ex.Sheets("Feuil1" ).Cells(lig, 40).Value
- 'Numero de telephone / télécopie (bureau)
- oCont.BusinessFaxNumber = ex.Sheets("Feuil1" ).Cells(lig, 11).Value
- 'Numero de telephone / telephone mobile
- oCont.MobileTelephoneNumber = ex.Sheets("Feuil1" ).Cells(lig, 15).Value
- 'Numero de telephone / Domicile
- oCont.HomeTelephoneNumber = ex.Sheets("Feuil1" ).Cells(lig, 16).Value
- 'Adresse de messagerie
- oCont.Email1Address = ex.Sheets("Feuil1" ).Cells(lig, 12).Value
- lig = lig + 1
- oCont.Save()
- Loop
- 'A la fin faut fermer excel
- oApp.Quit()
- 'On libère les ressources
- ex = Nothing
- oApp = Nothing
- 'ON detruit le procces EXCEL.EXE
- GC.Collect()
- 'On empeche le form2 de s'afficher
- Me.Close()
- End Sub
- End Class
|
Message édité par hazzelthorn le 17-02-2010 à 10:10:22
|