Optimisation VBscript HTA

Invité · 10/04/2019, 16h07

Bonjour
J'ai quelques aprioris sur la mise en œuvre de mon script.
Il fonctionne mais, je pense qu'il est possible de simplifier les choses
Comme par exemple le fait que j’établis plusieurs connexions à mon serveur et que je rappelle aussi plusieurs fois certain paramètres.
Avis aux plus perfectionnistes

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
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
<!-- 'Informations de connexion:
'URL du serveur phpMyAdmin:
'IP_SERVEUR/localhost/locationposte/location

'Requête SQL:
'SELECT *
'FROM location
'WHERE ( `DefaultPrinter` LIKE '%Printer_Name%')
'OR ( `2ndPrinter` LIKE '%Printer_Name%')
'OR ( `3rdPrinter` LIKE '%Printer_Name%')
'OR ( `4thPrinter` LIKE '%Printer_Name%')
'OR ( `5thPrinter` LIKE '%Printer_Name%')


'SELECT *  FROM `location` WHERE `ClientName` LIKE 'non-du-pc' ORDER BY `ClientName` ASC

'Prérequis:
'mysql-connector-odbc-8.0.14-win32.msi

'Configuration sous OS 64 bits:
'Depuis l’application "odbcad32" disponible en C:\Windows\SysWOW64.
'Sous l’onglet : Sources de données système => Ajouter.
'Sélectionner le bon pilote dans la liste et le configurer. -->

<HTML>
        <HEAD>
        <TITLE> SQL BBD Printers Request </TITLE>
                <HTA:APPLICATION
         ApplicationName = "SQL BBD Printers Request"
         Id="SQL BBD Printers Request"
         BORDER="dialog"
         BORDERSTYLE="complex"
         MAXIMIZEBUTTON="no"
         SCROLL="no"
         ICON="PHP_icon.ico"
                >
   </HEAD>
<SCRIPT language="VBScript" type="text/VBScript" >
'------------------------------------------------------------------------------------------------------------------
 
OPTION Explicit
 
        Dim StrDataSource
        Dim StrInitialCatalog
        Dim StrTableName
        Dim StrUserId
        Dim StrPassword
        Dim StrPort
        Dim ObjConnection
        Dim ObjRecordset
        Dim StrConnectionString
        Dim ObjMySQL
        Dim ErrMsg
        Dim StrColumnDefaultPrinter, StrColumn2ndPrinter, StrColumn3rdPrinter, StrColumn4thPrinter, StrColumn5thPrinter
        Dim PrinterName
        Dim strSelectedValues
        Dim i
        Dim StrColumnClientName
        Dim MsG
 
        StrDataSource = "IP_SERVEUR"
        StrInitialCatalog = "locationposte" 'BDD
        StrTableName = "location" 'Table
        StrUserId = "read" 
        StrPassword = "read"
        StrPort = "3306" 
        StrColumnClientName = "ClientName"
        StrColumnDefaultPrinter = "DefaultPrinter"
        StrColumn2ndPrinter = "2ndPrinter"
        StrColumn3rdPrinter = "3rdPrinter"
        StrColumn4thPrinter = "4thPrinter"
        StrColumn5thPrinter = "5thPrinter"      
 
Sub Window_Onload()
 
    self.ResizeTo 550,550      
 
End Sub
 
sub checkEnter
        If document.parentWindow.event.KeyCode = 13 Then Call run
End sub
 
Sub run
 
        PrinterName = TxtPrinterName.value
 
        If PrinterName = "" Then
                MsgBox "Attention: ce champ ne peut étre vide!"
                Exit Sub
        End If
 
        StrConnectionString = "DRIVER={MySQL ODBC 8.0 Unicode Driver}; SERVER=" & StrDataSource & _
                                                                                                                                ";PORT=" & StrPort & _
                                                                                                                                ";DATABASE=" & StrInitialCatalog & _
                                                                                                                                ";UID=" & StrUserId & _
                                                                                                                                ";PASSWORD=" & StrPassword &_
                                                                                                                                ";OPTION=3"
 
        ObjMySQL = "SELECT * FROM " & StrTableName & " WHERE (`" & _
                                                                        StrColumnDefaultPrinter & "` LIKE '%" & PrinterName & "%') OR (`" & _
                                                                        StrColumn2ndPrinter & "` LIKE '%" & PrinterName & "%') OR (`" & _
                                                                        StrColumn3rdPrinter & "` LIKE '%" & PrinterName & "%') OR (`" & _
                                                                        StrColumn4thPrinter & "` LIKE '%" & PrinterName & "%') OR (`" & _
                                                                        StrColumn5thPrinter & "` LIKE '%" & PrinterName & "%')" 
 
        Set ObjConnection = CreateObject("ADODB.Connection")
        Set ObjRecordset = CreateObject("ADODB.Recordset")
 
        On Error Resume Next
        ObjConnection.Open StrConnectionString
 
        If err.number = -2147467259 Then
                If instr(1,Err.Description,"server") <> 0 Then
                        ObjConnection.Close
                        ErrMsg = "Erreur N°" & Err.Number & vbCrLf _
                & "Hôte de serveur MySQL inconnu!" & vbCrLf _
                        & "Vérifier votre connexion réseau, la nom ou l'adresse IP du serveur." & vbCrLf _
                        & "Vérifier aussi que vous possédez les droits nécessaire."
                        MsgBox ErrMsg, vbCritical, "Erreur MySQL"
                End If
 
                If instr(1,Err.Description,"database") <> 0 Then
                        ObjConnection.Close
                        ErrMsg = "Erreur N°" & Err.Number & vbCrLf _
                        & "Accès refusé pour l'utilisateur (" & StrUserId & ") Sur la BDD (" & StrInitialCatalog & ") !" & vbCrLf _
                        & "Vérifier son nom et que vous possédez les droits nécessaire."
                        MsgBox ErrMsg, vbCritical, "Erreur MySQL"
                End If                  
        Else
                ObjRecordset.Open ObjMySQL,ObjConnection
                If err.number = -2147217865 Then
                        If instr(1,Err.Description,"Table") <> 0 Then
                                ObjConnection.Close
                                ErrMsg = "Erreur N°" & Err.Number & vbCrLf _
                                & "La table " & StrTableName & " n'existe pas ou est injoignable !" & vbCrLf _
                                & "Vérifier son nom et que vous possédez les droits nécessaire."
                                MsgBox ErrMsg, vbCritical, "Erreur MySQL"
                        End If
        Else
        Dim oOption, V 
        'vide la liste
        For V = LstClient.length To 0 Step -1: LstClient.Remove (V): Next
        V=0
                While Not ObjRecordset.EOF
                        'ajoute les noms à la liste 
                        Set oOption = document.createElement("OPTION")
                        oOption.Text = ObjRecordset.fields("ClientName")
                        oOption.Value = "Option " & V
                        LstClient.Add (oOption)
                V = V + 1               
                        ObjRecordset.MoveNext
        Wend
 
                ObjRecordset.Close: Set ObjRecordset = Nothing
                ObjConnection.Close: Set ObjConnection = Nothing
 
        If V = 0 Then
                Set oOption = document.createElement("OPTION")
                oOption.Text = "Aucun enregistrement disponible pour cette requête"
                oOption.Value = V
                LstClient.Add (oOption)
                LstClient.disabled = "disabled"
        Else
                LstClient.disabled = ""
                        'MsgBox V & " Client(s) trouvée(s)"
                        document.getElementById("txtNbClient").Value = V & " Client(s) trouvée(s)"
                End If
        End If
End If
 
End Sub 
 
Sub showchange()
 
        Set ObjConnection = CreateObject("ADODB.Connection")
        Set ObjRecordset = CreateObject("ADODB.Recordset")
 
        StrConnectionString = "DRIVER={MySQL ODBC 8.0 Unicode Driver}; SERVER=" & StrDataSource & _
                                                                                                                                ";PORT=" & StrPort & _
                                                                                                                                ";DATABASE=" & StrInitialCatalog & _
                                                                                                                                ";UID=" & StrUserId & _
                                                                                                                                ";PASSWORD=" & StrPassword &_
                                                                                                                                ";OPTION=3"
 
        ObjConnection.ConnectionString = StrConnectionString
        ObjConnection.Open      
 
        For i = 0 to (LstClient.Options.Length - 1)
                If (LstClient.Options(i).Selected) Then
                        strSelectedValues = LstClient.Options(i).Text
        Exit For 
                End If
        Next
 
        ObjMySQL = "SELECT *  FROM " & StrTableName & " WHERE (`" & StrColumnClientName & "`  LIKE '%" & strSelectedValues & "%')"
 
        ObjRecordset.Open ObjMySQL, ObjConnection
 
        'MsgBox strSelectedValues
        'MsgBox ObjMySQL
 
        MsG = "Client: " &  ObjRecordset.Fields("ClientName") & vbNewLine & "ID: " & ObjRecordset.Fields("id")
 
        If Not IsNull(ObjRecordset.Fields(StrColumnDefaultPrinter)) Then
                MsG = MsG & vbNewLine & "DefaultPrinter: " & ObjRecordset.Fields(StrColumnDefaultPrinter)
        End If
 
        If Not IsNull(ObjRecordset.Fields(StrColumn2ndPrinter)) Then
                MsG = MsG & vbNewLine & "2ndPrinter: " & ObjRecordset.Fields(StrColumn2ndPrinter)
        Else
                MsG = MsG & vbNewLine & "2ndPrinter: Null"
        End If
 
        If Not IsNull(ObjRecordset.Fields(StrColumn3rdPrinter)) Then
                MsG = MsG & vbNewLine & "3rdPrinter: " & ObjRecordset.Fields(StrColumn3rdPrinter)
        Else
                MsG = MsG & vbNewLine & "3rdPrinter: Null"              
        End If
 
        If Not IsNull(ObjRecordset.Fields(StrColumn4thPrinter)) Then
                MsG = MsG & vbNewLine & "4thPrinter: " & ObjRecordset.Fields(StrColumn4thPrinter)
        Else
                MsG = MsG & vbNewLine & "4thPrinter: Null"      
        End If
 
        If Not IsNull(ObjRecordset.Fields(StrColumn5thPrinter)) Then
                MsG = MsG & vbNewLine & "5thPrinter: " & ObjRecordset.Fields(StrColumn5thPrinter)
        Else
                MsG = MsG & vbNewLine & "5thPrinter: Null"                      
        End If
 
        'MsgBox MsG, vbInformation, "Rapport"
 
        document.getElementById("txtAffiche").Value = MsG
 
        ObjRecordset.Close: Set ObjRecordset = Nothing
        ObjConnection.Close: Set ObjConnection = Nothing    
 
End Sub  
 
'------------------------------------------------------------------------------------------------------------------
  </SCRIPT>
        <Body>
                <b>Saisir le nom de l’imprimante :</b><br></p>
                <input type="text" name="TxtPrinterName" value="" onkeydown="checkEnter"></p>
                <input id=runbutton  class="button" type="button" value="GO" onClick="run"><p>
                <input type="text" name="txtNbClient" ID="txtNbClient" value="" disabled="disabled"><p>
                <b>Sélectionner un PC dans la liste :</b><br></p>
                <select name="LstClient" id="LstClient" disabled="disabled" size=5 onclick="showchange"><p>
                <option value="LstClient">Client Name </option>
                </select><p>
                <TEXTAREA name="txtAffiche" id="txtAffiche" value="" Rows="7"; Cols="55"></TEXTAREA>
                <img src="Jura_Sud_Logo_Couleur.jpg" style="position: absolute; Left:250px; Top:30px; height:170px; width:240px">
   </Body>
</HTML>

Invité · 15/04/2019, 12h48

Bonjour,
Aucun avis?
Je pensais par exemple à une Sub de connexion:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Public Sub MySQLodbcConnect()
    on error resume next
    Set ObjConnection = CreateObject("ADODB.Connection")
    Set ObjRecordset = CreateObject("ADODB.Recordset")
    StrConnectionString = "DRIVER={MySQL ODBC 8.0 Unicode Driver}; SERVER=" & StrDataSource & _
                                                                ";PORT=" & StrPort & _
                                                                ";DATABASE=" & StrInitialCatalog & _
                                                                ";UID=" & StrUserId & _
                                                                ";PASSWORD=" & StrPassword &_
                                                                ";OPTION=3"
End Sub

Puis l'appeler à la demande:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Call MySQLodbcConnect

Est-ce mieux ou pas ?

**l_autodidacte** · 15/04/2019, 18h23

La chaîne de connexion à la BDD étant la même dans tout le code, j'aurait opté pour la création des deux objets ObjConnection et ObjRecordset juste après la déclaration des variables et non dans une fonction ou procédure.

De cette façon-là, ces 2 objets restent disponibles et visibles dans toute fonction/procédure tant que ni l'un et / ou ni l'autre n'a été fermé/détruit.

Par contre, ce qui change c'est seulement la requête SQL suivant les données visées.

Invité · 16/04/2019, 09h59

Bonjour,
Quand je sors la création de mes deux objets ObjConnection et ObjRecordset de mes "Sub" je ne parviens pas à faire mon appel à la bonne source "ObjMySQL".
Je viens de créer le chaos dans mon script. Je reprends depuis le début, mais j'ai vraiment du mal à me projeter!
Un petit coup de main ou un petit exemple SVP?

**l_autodidacte** · 16/04/2019, 11h02

ObjMySQL est utilisé par 2 Subs; de ce fait, il y a amalgame.
Cette variable n'est pas de type objet, c'est une chaîne qu'il vaudrait mieux déclarer autrement, par exemple reqSQL car le préfixe Obj fait penser à un objet. Utilise cette variable uniquement dans la Sub Run.
Déclare une autre variable globale(en dehors de la Sub, par exemple SQLAffiche) à utiliser dans la Sub showchange.
En sortant de l'une ou l'autre Sub, tu as accès à ces variables avec les valeurs qu'elles contiennent lors de l'appel de ces Subs.
Voici un exemple très simple :

Invité · 16/04/2019, 15h06

Merci pour l'exemple
Je pense avoir compris et avoir appliqué selon tes recommandations.
Seul bémol je dois surement fermer la connexion au mauvais endroit car si je modifie la saisie de mon "TxtPrinterName" et valide, il ne se passe rien.

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
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
<!-- 'Informations de connexion:
'URL du serveur phpMyAdmin:
'IP_SERVEUR/localhost/locationposte/location
 
'Requête SQL:
'SELECT *
'FROM location
'WHERE ( `DefaultPrinter` LIKE '%Printer_Name%')
'OR ( `2ndPrinter` LIKE '%Printer_Name%')
'OR ( `3rdPrinter` LIKE '%Printer_Name%')
'OR ( `4thPrinter` LIKE '%Printer_Name%')
'OR ( `5thPrinter` LIKE '%Printer_Name%')
 
 
'SELECT *  FROM `location` WHERE `ClientName` LIKE 'non-du-pc' ORDER BY `ClientName` ASC
 
'Prérequis:
'mysql-connector-odbc-8.0.14-win32.msi
 
'Configuration sous OS 64 bits:
'Depuis l’application "odbcad32" disponible en C:\Windows\SysWOW64.
'Sous l’onglet : Sources de données système => Ajouter.
'Sélectionner le bon pilote dans la liste et le configurer. -->
<HTML>
        <HEAD>
        <TITLE> SQL BBD Printers Request </TITLE>
                <HTA:APPLICATION
         ApplicationName = "SQL BBD Printers Request"
         Id="SQL BBD Printers Request"
         BORDER="dialog"
         BORDERSTYLE="complex"
         MAXIMIZEBUTTON="no"
         SCROLL="no"
         ICON="PHP_icon.ico"
                >
   </HEAD>
<SCRIPT language="VBScript" type="text/VBScript" >
 
'------------------------------------------------------------------------------------------------------------------
 
OPTION Explicit
 
        Dim StrDataSource
        Dim StrInitialCatalog
        Dim StrTableName
        Dim StrUserId
        Dim StrPassword
        Dim StrPort
        Dim ObjConnection
        Dim ObjRecordset
        Dim StrConnectionString
        Dim ReqMySQL_FindPrinter
        Dim ReqMySQL_InfoClient
        Dim ErrMsg
        Dim StrColumnDefaultPrinter, StrColumn2ndPrinter, StrColumn3rdPrinter, StrColumn4thPrinter, StrColumn5thPrinter
        Dim PrinterName
        Dim strSelectedValues
        Dim i
        Dim StrColumnClientName
        Dim MsG
 
        StrDataSource = "IP_SERVEUR"
        StrInitialCatalog = "locationposte" 'BDD
        StrTableName = "location" 'Table
        StrUserId = "read" 
        StrPassword = "read"
        StrPort = "3306" 
        StrColumnClientName = "ClientName"
        StrColumnDefaultPrinter = "DefaultPrinter"
        StrColumn2ndPrinter = "2ndPrinter"
        StrColumn3rdPrinter = "3rdPrinter"
        StrColumn4thPrinter = "4thPrinter"
        StrColumn5thPrinter = "5thPrinter"      
 
Set ObjConnection = CreateObject("ADODB.Connection")
 
Sub ConnectDB()
        If ObjConnection.State = 0 Then
                Set ObjConnection = CreateObject("ADODB.Connection")
                Set ObjRecordset = CreateObject("ADODB.Recordset")
                StrConnectionString = "DRIVER={MySQL ODBC 8.0 Unicode Driver};SERVER=" & StrDataSource & _
                                      ";PORT=" & StrPort & _
                                      ";DATABASE=" & StrInitialCatalog & _
                                      ";UID=" & StrUserId & _
                                      ";PASSWORD=" & StrPassword &_
                                      ";OPTION=3"                                                                                                                                                                                                                       
                ObjConnection.Open StrConnectionString
        Else
            Exit Sub
        End If   
End Sub
 
Sub Window_Onload()
    self.ResizeTo 550,550      
End Sub
 
sub checkEnter
        If document.parentWindow.event.KeyCode = 13 Then Call run
End sub
 
Sub run 
        PrinterName = TxtPrinterName.value
 
        If PrinterName = "" Then
                MsgBox "Attention: ce champ ne peut étre vide!"
                Exit Sub
        End If
 
        ReqMySQL_FindPrinter = "SELECT * FROM " & StrTableName & " WHERE (`" & _
                                StrColumnDefaultPrinter & "` LIKE '%" & PrinterName & "%') OR (`" & _
                                StrColumn2ndPrinter & "` LIKE '%" & PrinterName & "%') OR (`" & _
                                StrColumn3rdPrinter & "` LIKE '%" & PrinterName & "%') OR (`" & _
                                StrColumn4thPrinter & "` LIKE '%" & PrinterName & "%') OR (`" & _
                                StrColumn5thPrinter & "` LIKE '%" & PrinterName & "%')" 
        On Error Resume Next
        Call ConnectDB
 
        If err.number = -2147467259 Then
                If instr(1,Err.Description,"server") <> 0 Then
                        ObjConnection.Close
                        ErrMsg = "Erreur N°" & Err.Number & vbCrLf _
                & "Hôte de serveur MySQL inconnu!" & vbCrLf _
                        & "Vérifier votre connexion réseau, la nom ou l'adresse IP du serveur." & vbCrLf _
                        & "Vérifier aussi que vous possédez les droits nécessaire."
                        MsgBox ErrMsg, vbCritical, "Erreur MySQL"
                End If
 
                If instr(1,Err.Description,"database") <> 0 Then
                        ObjConnection.Close
                        ErrMsg = "Erreur N°" & Err.Number & vbCrLf _
                        & "Accès refusé pour l'utilisateur (" & StrUserId & ") Sur la BDD (" & StrInitialCatalog & ") !" & vbCrLf _
                        & "Vérifier son nom et que vous possédez les droits nécessaire."
                        MsgBox ErrMsg, vbCritical, "Erreur MySQL"
                End If                  
        Else
                ObjRecordset.Open ReqMySQL_FindPrinter,ObjConnection
                If err.number = -2147217865 Then
                        If instr(1,Err.Description,"Table") <> 0 Then
                                ObjConnection.Close
                                ErrMsg = "Erreur N°" & Err.Number & vbCrLf _
                                & "La table " & StrTableName & " n'existe pas ou est injoignable !" & vbCrLf _
                                & "Vérifier son nom et que vous possédez les droits nécessaire."
                                MsgBox ErrMsg, vbCritical, "Erreur MySQL"
                        End If
        Else
        Dim oOption, V 
        'vide la liste
        For V = LstClient.length To 0 Step -1: LstClient.Remove (V): Next
        V=0
                While Not ObjRecordset.EOF
                        'ajoute les noms à la liste 
                        Set oOption = document.createElement("OPTION")
                        oOption.Text = ObjRecordset.fields("ClientName")
                        oOption.Value = "Option " & V
                        LstClient.Add (oOption)
                V = V + 1               
                        ObjRecordset.MoveNext
        Wend
 
                ObjRecordset.Close: Set ObjRecordset = Nothing
                ObjConnection.Close: Set ObjConnection = Nothing
 
        If V = 0 Then
                Set oOption = document.createElement("OPTION")
                oOption.Text = "Aucun enregistrement disponible pour cette requête"
                oOption.Value = V
                LstClient.Add (oOption)
                LstClient.disabled = "disabled"
        Else
                LstClient.disabled = ""
                        'MsgBox V & " Client(s) trouvée(s)"
                        document.getElementById("txtNbClient").Value = V & " Client(s) trouvée(s)"
                End If
        End If
End If
End Sub 
 
Sub showchange()
        Set ObjConnection = CreateObject("ADODB.Connection")
        Call ConnectDB
 
        For i = 0 to (LstClient.Options.Length - 1)
                If (LstClient.Options(i).Selected) Then
                        strSelectedValues = LstClient.Options(i).Text
        Exit For 
                End If
        Next
 
        ReqMySQL_InfoClient = "SELECT *  FROM " & StrTableName & " WHERE (`" & StrColumnClientName & "`  LIKE '%" & strSelectedValues & "%')"
 
        ObjRecordset.Open ReqMySQL_InfoClient,ObjConnection
 
        'MsgBox strSelectedValues
        'MsgBox ReqMySQL_InfoClient
 
        MsG = "Client: " &  ObjRecordset.Fields("ClientName") & vbNewLine & "ID: " & ObjRecordset.Fields("id")
 
        If Not IsNull(ObjRecordset.Fields(StrColumnDefaultPrinter)) Then
                MsG = MsG & vbNewLine & "DefaultPrinter: " & ObjRecordset.Fields(StrColumnDefaultPrinter)
        End If
 
        If Not IsNull(ObjRecordset.Fields(StrColumn2ndPrinter)) Then
                MsG = MsG & vbNewLine & "2ndPrinter: " & ObjRecordset.Fields(StrColumn2ndPrinter)
        Else
                MsG = MsG & vbNewLine & "2ndPrinter: Null"
        End If
 
        If Not IsNull(ObjRecordset.Fields(StrColumn3rdPrinter)) Then
                MsG = MsG & vbNewLine & "3rdPrinter: " & ObjRecordset.Fields(StrColumn3rdPrinter)
        Else
                MsG = MsG & vbNewLine & "3rdPrinter: Null"              
        End If
 
        If Not IsNull(ObjRecordset.Fields(StrColumn4thPrinter)) Then
                MsG = MsG & vbNewLine & "4thPrinter: " & ObjRecordset.Fields(StrColumn4thPrinter)
        Else
                MsG = MsG & vbNewLine & "4thPrinter: Null"      
        End If
 
        If Not IsNull(ObjRecordset.Fields(StrColumn5thPrinter)) Then
                MsG = MsG & vbNewLine & "5thPrinter: " & ObjRecordset.Fields(StrColumn5thPrinter)
        Else
                MsG = MsG & vbNewLine & "5thPrinter: Null"                      
        End If
 
        'MsgBox MsG, vbInformation, "Rapport"
 
        document.getElementById("txtAffiche").Value = MsG
 
        ObjRecordset.Close: Set ObjRecordset = Nothing
        ObjConnection.Close: Set ObjConnection = Nothing        
End Sub  
 
'------------------------------------------------------------------------------------------------------------------
  
 </SCRIPT>
        <Body>
                <b>Saisir le nom de l’imprimante :</b><br></p>
                <input type="text" name="TxtPrinterName" value="" onkeydown="checkEnter"></p>
                <input id=runbutton  class="button" type="button" value="GO" onClick="run"><p>
                <input type="text" name="txtNbClient" ID="txtNbClient" value="" disabled="disabled"><p>
                <b>Sélectionner un PC dans la liste :</b><br></p>
                <select name="LstClient" id="LstClient" disabled="disabled" size=5 onclick="showchange"><p>
                <option value="LstClient">Client Name </option>
                </select><p>
                <TEXTAREA name="txtAffiche" id="txtAffiche" value="" Rows="7"; Cols="55"></TEXTAREA>
                <img src="Jura_Sud_Logo_Couleur.jpg" style="position: absolute; Left:250px; Top:30px; height:170px; width:240px">
   </Body>
</HTML>

Invité · 17/04/2019, 08h46

Bonjour,
Bon apparemment mon problème ne semble pas être dû au fait que je ferme les connexions au mauvaise endroit, mais que pour relancer la recherche depuis ma boite de saisie "TxtPrinterName" sans relancer mon HTA je dois réinitialiser et recharger la connexion.
Je ne vois pas trop comment gérer cela!
Pouvez-vous m'aider?

**l_autodidacte** · 17/04/2019, 15h46

Seul bémol je dois surement fermer la connexion au mauvais endroit car si je modifie la saisie de mon "TxtPrinterName" et valide, il ne se passe rien.

Comment fais-tu la validation ?
D'autre part, l'utilisation de On Error Resume Next peut cacher des erreurs qu'il faut gérer.
Essaie de mettre cette instruction en commentaire pour voir s'il y a erreur ou non.

Invité · 17/04/2019, 16h28

Bien vu, sans le "On Error Resume Next"
J'ai un message
Line: 77
Column: 2
Error: Objet requis: 'ObjConnection'
Code: 800A01A8
Source: Erreur d'exécution Microsoft VBScript
C'est de ça que je parlais plus haut!
Vu que la connexion est fermée, il faut que je la réinitialise! Je ne sais pas trop où et comment agir!

**l_autodidacte** · 17/04/2019, 20h07

La ligne 77 contient Sub ConnectDB() donc pas de ObjConnection ici
Mais... commence par modifier cette procédure comme suit :

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
Sub ConnectDB()
      If ObjConnection.State = 0 Then
           Set ObjConnection = CreateObject("ADODB.Connection")
           Set ObjRecordset = CreateObject("ADODB.Recordset")
           StrConnectionString = "DRIVER={MySQL ODBC 8.0 Unicode Driver};SERVER=" & StrDataSource & _
                               ";PORT=" & StrPort & _
                               ";DATABASE=" & StrInitialCatalog & _
                               ";UID=" & StrUserId & _
                               ";PASSWORD=" & StrPassword &_
                               ";OPTION=3"                                                                                                                                                 
          ObjConnection.Open StrConnectionString
     Else
          Set ObjRecordset = CreateObject("ADODB.Recordset")
          StrConnectionString = "DRIVER={MySQL ODBC 8.0 Unicode Driver};SERVER=" & StrDataSource & _
                               ";PORT=" & StrPort & _
                               ";DATABASE=" & StrInitialCatalog & _
                               ";UID=" & StrUserId & _
                               ";PASSWORD=" & StrPassword &_
                               ";OPTION=3"                                                                                                                                                 
          ObjConnection.Open StrConnectionString
   End If   
End Sub

Invité · 17/04/2019, 22h01

Après modification, Bien que la ligne 77 contienne Sub ConnectDB().
J'ai toujours le même message :
Line: 77
Column: 2
Error: Objet requis: 'ObjConnection'
Code: 800A01A8
Source: Erreur d'exécution Microsoft VBScript

Pour rappel :
Ce message apparait après saisie du "TxtPrinterName", si je clique 2 fois de suite sur le bouton Go ou 2 fois touche entrée!

**ProgElecT** · 17/04/2019, 22h21

Salut

Ton algo n'est pas bon,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
        If ObjConnection.State = 0 Then
                Set ObjConnection = CreateObject("ADODB.Connection")
' .......

ObjConnection n'est pas encore ou n'est plus un Objet, donc tu ne peux pas utiliser sa méthode.
Essais en modifier de cette façon

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
 
        If ObjConnection = Nothing Then
                Set ObjConnection = CreateObject("ADODB.Connection")
' .....

**ProgElecT** · 17/04/2019, 22h33

En approfondissant un peu plus, je me demande si il ne faudrait pas faire plutôt

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
Sub ConnectDB()
        If ObjConnection = Nothing Then
                Set ObjConnection = CreateObject("ADODB.Connection")
		End If
        If ObjRecordset = Nothing Then
                Set ObjRecordset = CreateObject("ADODB.Recordset")
                StrConnectionString = "DRIVER={MySQL ODBC 8.0 Unicode Driver};SERVER=" & StrDataSource & _
                                      ";PORT=" & StrPort & _
                                      ";DATABASE=" & StrInitialCatalog & _
                                      ";UID=" & StrUserId & _
                                      ";PASSWORD=" & StrPassword &_
                                      ";OPTION=3"                                                                                                                                                                                                                       
                ObjConnection.Open StrConnectionString
        End If   
End Sub

Invité · 17/04/2019, 22h36

Un message me dit que la variable objet est non définie

je suis un peu largué là!

**l_autodidacte** · 17/04/2019, 22h42

Envoyé par NeriXs

Un message me dit que la variable objet est non définie

je suis un peu largué là!
oups ton 2émé message est rivé avant ma repose!

A quelle ligne et dans quel code ?

Invité · 17/04/2019, 22h45

Toujours ligne 77 Sub ConnectDB().

**ProgElecT** · 17/04/2019, 22h48

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
Sub ConnectDB()
        If TypeName(ObjConnection) =  "Nothing" Then
                Set ObjConnection = CreateObject("ADODB.Connection")
		End If
        If TypeName(ObjRecordset) =  "Nothing" Then
                Set ObjRecordset = CreateObject("ADODB.Recordset")
                StrConnectionString = "DRIVER={MySQL ODBC 8.0 Unicode Driver};SERVER=" & StrDataSource & _
                                      ";PORT=" & StrPort & _
                                      ";DATABASE=" & StrInitialCatalog & _
                                      ";UID=" & StrUserId & _
                                      ";PASSWORD=" & StrPassword &_
                                      ";OPTION=3"                                                                                                                                                                                                                       
                ObjConnection.Open StrConnectionString
        End If   
End Sub

A ma décharge, j'ai en tête 7 langages différents, d’où l'erreur de mes messages précédant.

Invité · 17/04/2019, 22h58

Cette fois ci c'est Line: 135
Column: 3
Error: Objet requis: 'ObjRecordset
Code: 800A01A8
Source: Erreur d'exécution Microsoft VBScript

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
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
<!-- 'Informations de connexion:
'URL du serveur phpMyAdmin:
'IP-SERVER/localhost/locationposte/location
 
'Requête SQL:
'SELECT *
'FROM location
'WHERE ( `DefaultPrinter` LIKE '%Printer_Name%')
'OR ( `2ndPrinter` LIKE '%Printer_Name%')
'OR ( `3rdPrinter` LIKE '%Printer_Name%')
'OR ( `4thPrinter` LIKE '%Printer_Name%')
'OR ( `5thPrinter` LIKE '%Printer_Name%')
 
 
'SELECT *  FROM `location` WHERE `ClientName` LIKE 'non-du-pc' ORDER BY `ClientName` ASC
 
'Prérequis:
'mysql-connector-odbc-8.0.14-win32.msi
 
'Configuration sous OS 64 bits:
'Depuis l’application "odbcad32" disponible en C:\Windows\SysWOW64.
'Sous l’onglet : Sources de données système => Ajouter.
'Sélectionner le bon pilote dans la liste et le configurer. -->
 
<HTML>
	<HEAD>
	<TITLE> SQL BBD Printers Request </TITLE>
		<HTA:APPLICATION
         ApplicationName = "SQL BBD Printers Request"
         Id="SQL BBD Printers Request"
         BORDER="dialog"
         BORDERSTYLE="complex"
         MAXIMIZEBUTTON="no"
         SCROLL="no"
         ICON="PHP_icon.ico"
		>
   </HEAD>
<SCRIPT language="VBScript" type="text/VBScript" >
'------------------------------------------------------------------------------------------------------------------
 
OPTION Explicit
 
	Dim StrDataSource
	Dim StrInitialCatalog
	Dim StrTableName
	Dim StrUserId
	Dim StrPassword
	Dim StrPort
	Dim ObjConnection
	Dim ObjRecordset
	Dim StrConnectionString
	Dim ReqMySQL_FindPrinter
	Dim ReqMySQL_InfoClient
	Dim ErrMsg
	Dim StrColumnDefaultPrinter, StrColumn2ndPrinter, StrColumn3rdPrinter, StrColumn4thPrinter, StrColumn5thPrinter
	Dim PrinterName
	Dim strSelectedValues
	Dim i
	Dim StrColumnClientName
	Dim MsG
 
	StrDataSource = "IP-SERVER"
	StrInitialCatalog = "locationposte" 'BDD
	StrTableName = "location" 'Table
	StrUserId = "read" 
	StrPassword = "read"
	StrPort = "3306" 
	StrColumnClientName = "ClientName"
	StrColumnDefaultPrinter = "DefaultPrinter"
	StrColumn2ndPrinter = "2ndPrinter"
	StrColumn3rdPrinter = "3rdPrinter"
	StrColumn4thPrinter = "4thPrinter"
	StrColumn5thPrinter = "5thPrinter"	
 
Set ObjConnection = CreateObject("ADODB.Connection")
 
Sub ConnectDB()
        If TypeName(ObjConnection) =  "Nothing" Then
                Set ObjConnection = CreateObject("ADODB.Connection")
		End If
        If TypeName(ObjRecordset) =  "Nothing" Then
                Set ObjRecordset = CreateObject("ADODB.Recordset")
                StrConnectionString = "DRIVER={MySQL ODBC 8.0 Unicode Driver};SERVER=" & StrDataSource & _
                                      ";PORT=" & StrPort & _
                                      ";DATABASE=" & StrInitialCatalog & _
                                      ";UID=" & StrUserId & _
                                      ";PASSWORD=" & StrPassword &_
                                      ";OPTION=3"                                                                                                                                                                                                                       
                ObjConnection.Open StrConnectionString
        End If   
End Sub
 
Sub Window_Onload()
    self.ResizeTo 550,550      
End Sub
 
sub checkEnter
	If document.parentWindow.event.KeyCode = 13 Then Call run
End sub
 
Sub run	
	PrinterName = TxtPrinterName.value
 
	If PrinterName = "" Then
		MsgBox "Attention: ce champ ne peut étre vide!"
		Exit Sub
	End If
 
	ReqMySQL_FindPrinter = "SELECT * FROM " & StrTableName & " WHERE (`" & _
									StrColumnDefaultPrinter & "` LIKE '%" & PrinterName & "%') OR (`" & _
									StrColumn2ndPrinter & "` LIKE '%" & PrinterName & "%') OR (`" & _
									StrColumn3rdPrinter & "` LIKE '%" & PrinterName & "%') OR (`" & _
									StrColumn4thPrinter & "` LIKE '%" & PrinterName & "%') OR (`" & _
									StrColumn5thPrinter & "` LIKE '%" & PrinterName & "%')"	
	'On Error Resume Next
	Call ConnectDB
 
	If err.number = -2147467259 Then
		If instr(1,Err.Description,"server") <> 0 Then
			ObjConnection.Close
			ErrMsg = "Erreur N°" & Err.Number & vbCrLf _
    		& "Hôte de serveur MySQL inconnu!" & vbCrLf _
			& "Vérifier votre connexion réseau, la nom ou l'adresse IP du serveur." & vbCrLf _
			& "Vérifier aussi que vous possédez les droits nécessaire."
			MsgBox ErrMsg, vbCritical, "Erreur MySQL"
		End If
 
		If instr(1,Err.Description,"database") <> 0 Then
			ObjConnection.Close
			ErrMsg = "Erreur N°" & Err.Number & vbCrLf _
			& "Accès refusé pour l'utilisateur (" & StrUserId & ") Sur la BDD (" & StrInitialCatalog & ") !" & vbCrLf _
			& "Vérifier son nom et que vous possédez les droits nécessaire."
			MsgBox ErrMsg, vbCritical, "Erreur MySQL"
		End If			
	Else
		ObjRecordset.Open ReqMySQL_FindPrinter,ObjConnection
		If err.number = -2147217865 Then
			If instr(1,Err.Description,"Table") <> 0 Then
				ObjConnection.Close
				ErrMsg = "Erreur N°" & Err.Number & vbCrLf _
				& "La table " & StrTableName & " n'existe pas ou est injoignable !" & vbCrLf _
				& "Vérifier son nom et que vous possédez les droits nécessaire."
				MsgBox ErrMsg, vbCritical, "Erreur MySQL"
			End If
	Else
    	Dim oOption, V 
    	'vide la liste
    	For V = LstClient.length To 0 Step -1: LstClient.Remove (V): Next
    	V=0
		While Not ObjRecordset.EOF
			'ajoute les noms à la liste 
			Set oOption = document.createElement("OPTION")
			oOption.Text = ObjRecordset.fields("ClientName")
			oOption.Value = "Option " & V
			LstClient.Add (oOption)
        	V = V + 1               
			ObjRecordset.MoveNext
    	Wend
 
'		ObjRecordset.Close: Set ObjRecordset = Nothing
'		ObjConnection.Close: Set ObjConnection = Nothing
 
    	If V = 0 Then
        	Set oOption = document.createElement("OPTION")
        	oOption.Text = "Aucun enregistrement disponible pour cette requête"
        	oOption.Value = V
        	LstClient.Add (oOption)
        	LstClient.disabled = "disabled"
        Else
        	LstClient.disabled = ""
			'MsgBox V & " Client(s) trouvée(s)"
			document.getElementById("txtNbClient").Value = V & " Client(s) trouvée(s)"
		End If
	End If
End If
		ObjRecordset.Close: Set ObjRecordset = Nothing
		ObjConnection.Close: Set ObjConnection = Nothing
End Sub 
 
Sub showchange()
	Set ObjConnection = CreateObject("ADODB.Connection")
	Call ConnectDB
 
	For i = 0 to (LstClient.Options.Length - 1)
		If (LstClient.Options(i).Selected) Then
			strSelectedValues = LstClient.Options(i).Text
	Exit For 
		End If
	Next
 
	ReqMySQL_InfoClient = "SELECT *  FROM " & StrTableName & " WHERE (`" & StrColumnClientName & "`  LIKE '%" & strSelectedValues & "%')"
 
	ObjRecordset.Open ReqMySQL_InfoClient,ObjConnection
 
	'MsgBox strSelectedValues
	'MsgBox ReqMySQL_InfoClient
	'MsgBox ReqMySQL_FindPrinter
 
 	MsG = "Client: " &  ObjRecordset.Fields("ClientName") & vbNewLine & "ID: " & ObjRecordset.Fields("id")
 
	If Not IsNull(ObjRecordset.Fields(StrColumnDefaultPrinter)) Then
		MsG = MsG & vbNewLine & "DefaultPrinter: " & ObjRecordset.Fields(StrColumnDefaultPrinter)
	End If
 
	If Not IsNull(ObjRecordset.Fields(StrColumn2ndPrinter)) Then
		MsG = MsG & vbNewLine & "2ndPrinter: " & ObjRecordset.Fields(StrColumn2ndPrinter)
	Else
		MsG = MsG & vbNewLine & "2ndPrinter: Null"
	End If
 
	If Not IsNull(ObjRecordset.Fields(StrColumn3rdPrinter)) Then
		MsG = MsG & vbNewLine & "3rdPrinter: " & ObjRecordset.Fields(StrColumn3rdPrinter)
	Else
		MsG = MsG & vbNewLine & "3rdPrinter: Null"		
	End If
 
	If Not IsNull(ObjRecordset.Fields(StrColumn4thPrinter)) Then
		MsG = MsG & vbNewLine & "4thPrinter: " & ObjRecordset.Fields(StrColumn4thPrinter)
	Else
		MsG = MsG & vbNewLine & "4thPrinter: Null"	
	End If
 
	If Not IsNull(ObjRecordset.Fields(StrColumn5thPrinter)) Then
		MsG = MsG & vbNewLine & "5thPrinter: " & ObjRecordset.Fields(StrColumn5thPrinter)
	Else
		MsG = MsG & vbNewLine & "5thPrinter: Null"			
	End If
 
	'MsgBox MsG, vbInformation, "Rapport"
 
	document.getElementById("txtAffiche").Value = MsG
 
	ObjRecordset.Close: Set ObjRecordset = Nothing
	ObjConnection.Close: Set ObjConnection = Nothing        
End Sub  
 
'------------------------------------------------------------------------------------------------------------------
 </SCRIPT>
	<Body>
		<b>Saisir le nom de l’imprimante :</b><br></p>
		<input type="text" name="TxtPrinterName" value="" onkeydown="checkEnter"></p>
		<input id=runbutton  class="button" type="button" value="GO" onClick="run"><p>
		<input type="text" name="txtNbClient" ID="txtNbClient" value="" disabled="disabled"><p>
		<b>Sélectionner un PC dans la liste :</b><br></p>
		<select name="LstClient" id="LstClient" disabled="disabled" size=5 onclick="showchange"><p>
		<option value="LstClient">Client Name </option>
		</select><p>
		<TEXTAREA name="txtAffiche" id="txtAffiche" value="" Rows="7"; Cols="55"></TEXTAREA>
		<img src="Jura_Sud_Logo_Couleur.jpg" style="position: absolute; Left:250px; Top:30px; height:170px; width:240px">
   </Body>
</HTML>

**l_autodidacte** · 17/04/2019, 23h40

Modifie la Sub ConnectDB pour qu'elle soit la plus simple tout en mettant la ligne qui la précède en commentaire

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Sub ConnectDB()    
    Set ObjConnection = CreateObject("ADODB.Connection")
    Set ObjRecordset = CreateObject("ADODB.Recordset")
    StrConnectionString = "DRIVER={MySQL ODBC 8.0 Unicode Driver}" & _
                 ";SERVER=" & StrDataSource & _
                 ";PORT=" & StrPort & _
                 ";DATABASE=" & StrInitialCatalog & _
                 ";UID=" & StrUserId & _
                 ";PASSWORD=" & StrPassword &_
                 ";OPTION=3"                                                                                                                                                                   ObjConnection.Open StrConnectionString
End Sub

Dans la Sub showchange mets la 1ère ligne en commentaire.
Dans la sub Run, mets les 3 premières instructions ObjConnection.Close en commentaire puis exécute le fichier pour voir ce que cela donne.

Invité · 18/04/2019, 09h58

J'ai une erreur Ligne 86 caractère 192
Fin d'instruction attendue

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
77	Sub ConnectDB()    
78	    Set ObjConnection = CreateObject("ADODB.Connection")
79	   Set ObjRecordset = CreateObject("ADODB.Recordset")
80	    StrConnectionString = "DRIVER={MySQL ODBC 8.0 Unicode Driver}" & _
81               	  ";SERVER=" & StrDataSource & _
82	                ";PORT=" & StrPort & _
83	                 ";DATABASE=" & StrInitialCatalog & _
84	                 ";UID=" & StrUserId & _
85	                 ";PASSWORD=" & StrPassword &_
86	                ";OPTION=3"                                                                                                                                                                   
88	End Sub

Optimisation VBscript HTA

VBScript

Discussions similaires

Partager

Partager