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"
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 : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
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