Optimisation VBscript HTA

**l_autodidacte** · 18/04/2019, 11h33

A la ligne 85, remplace ";PASSWORD=" & StrPassword &_ par ";PASSWORD=" & StrPassword & _ (ajout d'un espace entre les caractères "&" et "_" )

Invité · 18/04/2019, 11h41

Bien vu, mais ça ne change rien! Même message

**l_autodidacte** · 18/04/2019, 12h20

Dans le code du post #18, il y a 3 instructions ObjConnection.Close aux lignes 120, 129 et 139 qui ne sont pas mises en commentaire. Donc s'il y a une erreur quelconque, la connexion à la BDD est fermée.

Les changements que j'ai demandés n'ont pas été suivis comme prévu mais tu as mis en commentaires les lignes 160 et 161(que tu peux laisser ainsi puisque tu les a ajoutées en bas)

PS : dans le code de ProgElecT (

), tu peux remplacer If TypeName(ObjConnection) = "Nothing" Then par If ObjConnection Is Nothing Then,
puis remplacer If TypeName(ObjRecordset) = "Nothing" Then par If ObjRecordset Is Nothing Then.

**ProgElecT** · 18/04/2019, 12h36

Salut .... Re

Ne faut-il pas un ; en fin d'une requête de connexion?

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
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

**l_autodidacte** · 18/04/2019, 12h48

Ne faut il pas un ; en fin d'une requête de connexion?

Bien sûr; mais l'erreur était l'espace manquant entre & et _ à la ligne précédente

Invité · 18/04/2019, 13h58

J'avoue être un peu largué là!
J'ai repris le code du poste #18
Maintenant j'ai cette erreur:
Line: 80
Column: 9
Error: Objet requis
Code: 800A01A8

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 ObjConnection Is Nothing Then
                Set ObjConnection = CreateObject("ADODB.Connection")
		End If
        If ObjRecordset Is 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** · 18/04/2019, 14h18

Et si tu mettais les lignes 75 et 181 en commentaire et tu remplaces la sub ConnectDB par celle du post #24 ?

Invité · 18/04/2019, 14h43

Bingo la ça fonctionne!
Bon je relis tout pour essayer de comprendre!
Par contre je dois dé-commenter le "On Error Resume Next" ligne 112 pour que ma gestion d'erreur fonctionne.

Du coup je suis un peu largué sur les lignes commentées
Ligne 75 je ne vois pas l'utilité?
Lignes 117, 126, 136 peuvent être dé-commentées pour arrêter la connexion en cas de problème non?
Lignes 157 et 158 peuvent être supprimées.
Ligne 178 je n'en vois pas l'utilité non plus?

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
<!-- '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()    
    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
 
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** · 18/04/2019, 16h12

Envoyé par NeriXs

Bingo la ça fonctionne! .....
Lignes 117, 126, 136 peuvent être dé-commentées pour arrêter la connexion en cas de problème non? ...

Ces lignes devraient être commentées ou supprimées car tu en as l'équivalent à la ligne 174

Pour les autres lignes que tu as mentionnées, je dirais oui, on peut maintenant les supprimer.

Une remarque si peux : Ton code est mal(ou pas bien) indenté; il est presque illisible/incompréhensible pour ceux qui n'ont assez de patience.
Les structures de contrôle étant trop imbriquées, là on se perd si on essaie de comprendre.
Une ligne séparatrice entre les modules ne fait qu'éclaircir le code.

Après purification et indentation, le code serait :

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
<!-- '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"    
 
'================================
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
'================================ 
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
            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
            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
                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
 
 
            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 ShowChanges()
    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="ShowChanges"><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é · 18/04/2019, 16h50

Merci pour cette belle purification / indentation et pour l'aide!

Optimisation VBscript HTA

VBScript

Discussions similaires

Partager

Partager