erreur vbscript 80020009

**Nimegue23** · 19/07/2021, 16h01

*Bonjour *

Pourriez-vous m'aider a resourdre cette erreur sur la ligne 115 s'il vous plait?

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
Option Explicit
 
Const ForReading = 1, ForWriting = 2, ForAppending = 8
 
Dim oFSO,f
Dim strFileName
Dim strFileName_New
Dim strFileName_Sortie
Dim strNum_entree
Dim strNum_sortie
Dim strTemp
Dim strSave
Dim Nb_Tab
Dim i
Dim objConn2
Dim rs
Dim strSQL
Dim DossierSauvegarde
Dim DossierTravail
Dim DossierSauvegardeFinal
Dim DossierTravailFinal
Dim DossierSauvegardeFinalRecupPointages
Dim DossierE_RecupPointages
Dim AgeMaximalFichiers
Dim DossierDialine
Dim ResultLog
Dim DossierSauvegardeFinal7Carac
Dim DossierLogs
 
 
Nb_Tab = 7
 
Set oFso = CreateObject("Scripting.FileSystemObject") 
 
 
'Repertoire ou sont stockes les fichiers 
DossierTravail = "E:\SiportExportvision"
'Ouverture du fichier de log
DossierLogs=DossierTravail & "\Logs scripts"
Set ResultLog = oFso.OpenTextFile(DossierLogs & "\Log_Siport_Export_Pointages_7_carac-" & year(now) & "-" & month(now) & "-" & day(now) & "-" & hour(now) & "-" & minute(now) & ".txt",ForAppending, True)
ResultLog.writeline Now() & "------Debut du script---"
 
 
DossierSauvegarde = DossierTravail & "\Pointages 7 caracteres" 
 
'DossierTravailFinal="\\frrmrdg-fs02\Horaires_Variables$"
'DossierSauvegardeFinal="\\frrmrdg-fs02\Horaires_Variables$\SAV"
'DossierSauvegardeFinalRecupPointages="\\frrmrdg-fs02\Recup_Pointages$"
DossierTravailFinal="E:\Horaires_Variables"
DossierSauvegardeFinal="E:\Horaires_Variables\SAV"
DossierSauvegardeFinalRecupPointages="E:\Recup_Pointages"
DossierE_RecupPointages="E:\Recup_Pointages"
 
'--a rajouter
DossierSauvegardeFinal7Carac="E:\Horaires_Variables\SAV\7Carac"
 
DossierDialine = "E:\SiportDialineSync"
 
 
'Nombre de jours de conservation des Fichiers 
AgeMaximalFichiers = "10" 
 
 
strFileName = DossierTravail & "\Pointages.txt"
'on renomme le fichier d'origine
'call DeplaceRenommeFichier(DossierTravail,DossierSauvegarde,"Pointages.txt","Pointages-" & year(dateadd("d",-1, now)) & "-" & month(dateadd("d",-1, now)) & "-" & day(dateadd("d",-1, now)) & ".txt")
'strFileName_New = DossierSauvegarde & "\" & "Pointages-" & year(dateadd("d",-1, now)) & "-" & month(dateadd("d",-1, now)) & "-" & day(dateadd("d",-1, now)) & ".txt"
call DeplaceRenommeFichier(DossierTravail,DossierSauvegarde,"Pointages.txt","Pointages-" & year(now) & "-" & month(now) & "-" & day(now) & "-" & hour(now) & "-" & minute(now) & ".txt")
strFileName_New = DossierSauvegarde & "\" & "Pointages-" & year(now) & "-" & month(now) & "-" & day(now) & "-" & hour(now) & "-" & minute(now) & ".txt"
 
'strFileName_Sortie = "E:\SiportExportvision\Pointages 7 caracteres\pointages-" & year(dateadd("d",-1, now)) & "-" & month(dateadd("d",-1, now)) & "-" & day(dateadd("d",-1, now)) & ".txt"
'strFileName_Sortie = "E:\SiportExportvision\Pointages 7 caracteres\Pointages-2019-10-23.txt"
strFileName_Sortie = DossierTravail & "\Pointages.txt"
 
'----Paramètre de connexion à SQL------
Set objConn2 = wscript.CreateObject("ADODB.Connection")
objconn2.ConnectionTimeout=5000
objconn2.CommandTimeout=5000
objconn2.open
 
If Err.number <> 0 Then
	ResultLog.writeline Now() & "------ERROR: Connection impossible à la Base SQL SIPORT---" & Err.Number & " -- " & Err.Description  & VbCrLf
	On Error GoTo 0
	Wscript.Quit
else
	ResultLog.writeline Now() & "-------Connection à la Base SQL SIPORT OK---"
End If
 
 
 
Set f = oFso.OpenTextFile(strFileName_New, ForReading)
ResultLog.writeline Now() & "-------Lecture du fichier des pointages sur 6 caracteres---"
while Not f.AtEndOfStream  
	'on lit la ligne
    'wscript.echo f.ReadLine 
	strTemp = f.ReadLine 
	strSave = strTemp
	'on réécrit la ligne dans le fichier de sortie
    For i = 1 To Nb_Tab
        strTemp = Mid(strTemp, InStr(1, strTemp, vbTab) + 1)
        'msgbox strTemp
    Next
    If InStr(1, strTemp, " ") <> 0 Then
    ' vbTab = Chr(9)
    ' Traitement souhaité si on trouve un Tab
        'SearchUserName = strLineOfText
        strNum_entree = Mid(strTemp, 1, InStr(1, strTemp, " ") - 1)
		'requete de récupération de l'IGG dans la base SIPORT
		Set rs = Wscript.CreateObject("ADODB.recordset")
		strSQL = "SELECT IGG FROM Table_Persext WHERE [CardNo]  = '" & strNum_entree &"'"
		rs.open strSQL, objconn2, 3,3
 
		'rs.MoveLast
		if trim(rs.fields("IGG")) <> "" then  Ligne 115
			strNum_sortie = rs.fields("IGG")
			WriteLog(replace(strSave ,strNum_entree & " ",mid(strNum_sortie,2)))
		end if
		rs.Close
		Set rs = Nothing
 
 
    End If
Wend 
f.Close
 
'on efface les fichiers supérieurs à 10 jours du dossier de sauvegarde de travail
ResultLog.writeline Now() & "-------on efface les fichiers supérieurs à 10 jours du dossier de sauvegarde de travail:" & DossierSauvegarde
Clean(DossierSauvegarde) 
 
'on copie le fichier pointages.txt vers E:\Horaires_Variables
'call CopyFichier(DossierTravail,DossierTravailFinal,"Pointages.txt","Pointages.txt")
 
'on copie le fichier pointages.txt de sauvegarde vers E:\Horaires_Variables\SAV
'call CopyFichier(DossierTravail,DossierSauvegardeFinal,"Pointages.txt","Pointages-" & year(now) & month(now) & day(now) & ".txt")
 
'on efface les fichiers supérieurs à 10 jours du dossier de sauvegarde final 
'Clean(DossierSauvegardeFinal) 
 
'on copie le fichier dans E:\Recup_Pointages --> DossierE_RecupPointages de l'AP34
ResultLog.writeline Now() & "-------on copie le fichier pointages de " & DossierTravail & " vers " & DossierE_RecupPointages
call CopyFichier(DossierTravail,DossierE_RecupPointages,"Pointages.txt","Pointages.txt")
 
'on copie le fichier dans FRRMRDG-FS02\Recup_Pointages$
'call DeplaceRenommeFichier(DossierTravail,DossierSauvegardeFinalRecupPointages,"Pointages.txt","Pointages.txt")
 
'on efface les fichiers texte commençant par "Pointages" 
ResultLog.writeline Now() & "-------on efface les fichiers texte commençant par Pointages* du dossier:" & DossierDialine
CleanDialine(DossierDialine) 
 
'on copie le fichier pointages.txt sur 7 caracteres de DossierTravail  vers DossierSauvegardeFinal7Carac
ResultLog.writeline Now() & "-------on copie le fichier pointages de " & DossierTravail & " vers " & DossierSauvegardeFinal7Carac
call CopyFichier(DossierTravail,DossierSauvegardeFinal7Carac,"Pointages.txt","Pointages-" & year(now) & month(now) & day(now) & ".txt")
 
'on efface les fichiers de logs supérieurs à 10 jours dans le dossier de logs
ResultLog.writeline Now() & "-------on efface les fichiers de logs supérieurs à 10 jours dans le dossier de logs:" & DossierLogs
Clean(DossierLogs) 
 
 
ResultLog.writeline Now() & "------Fin du script---"
Set ResultLog = Nothing
 
Set oFso = Nothing
 
'----Déconnection de la base SQL SIPORT----- 
objconn2.close
Set objconn2=Nothing
 
wscript.quit
 
'--------------------------------------------------------------------------------------------------------
' Procedure:  WriteLog
'
' Usage   : Sert à écrire dans le fichier de log.txt en mode deboggage
'
' Par:    : PTE (EURIWARE) 2011-06-06
'--------------------------------------------------------------------------------------------------------
sub WriteLog(strText)
	dim filesys, filetxt
	'Const ForReading = 1, ForWriting = 2, ForAppending = 8
	Set filesys = CreateObject("Scripting.FileSystemObject")
    If filesys.FileExists(strFileName_Sortie) Then
		Set filetxt = filesys.OpenTextFile(strFileName_Sortie, ForAppending, True)
	Else
		Set filetxt = filesys.CreateTextFile(strFileName_Sortie, True)
    End If
 
	filetxt.WriteLine(strText)
	filetxt.Close
End Sub
 
Sub DeplaceRenommeFichier(OldFolder, NewFolder, OldFic, NewFic)
    Dim GestionFichier
    set GestionFichier = CreateObject("Scripting.FileSystemObject")
    GestionFichier.MoveFile OldFolder & "\" & OldFic, NewFolder & "\" & NewFic
    Set GestionFichier = Nothing
End Sub
 
Sub CopyFichier(OldFolder, NewFolder, OldFic, NewFic)
    Dim GestionFichier 
    set GestionFichier = CreateObject("Scripting.FileSystemObject")
    GestionFichier.CopyFile OldFolder & "\" & OldFic, NewFolder & "\" & NewFic
    Set GestionFichier = Nothing
End Sub
 
 
'Fonction d'effacement des fichiers 
Sub Clean(FolderPath) 
Dim Folder
Dim File
	Set Folder = oFso.Getfolder(FolderPath) 
 
	'On appelle recursivement la fonction s'il y a des sous dossiers 
	'Set SubFolder = Folder.SubFolders 
	'For Each CurrentFolder in SubFolder 
	'   Clean CurrentFolder.Path 
	'Next 
 
	'On efface les fichiers dans le dossier courant 
	For Each File In Folder.Files 
		If (DateDiff("d", File.DateLastModified, now) > CInt(AgeMaximalFichiers)) Then 
		  	'On verifie qu'ils ne sont pas en lecture seule 
		  	If File.Attributes And 1 Then File.Attributes = File.Attributes - 1 
			File.Delete() 
		End If 
	Next 
End Sub
 
'Fonction d'effacement des fichiers 
Sub CleanDialine(FolderPath) 
Dim Folder
Dim File
	Set Folder = oFso.Getfolder(FolderPath) 
	'On efface les fichiers dans le dossier courant 
	For Each File In Folder.Files 
		If instr(1,File.name,"Pointages") <> 0 then
			File.Delete() 
		End If 
	Next 
End Sub

merci d'avance,

**micniv** · 19/07/2021, 19h01

dans la ligne 115, faudrait p'tet ben mettre ligne 115 en commentaire ...

Code :

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

if trim(rs.fields("IGG")) <> "" then  ' Ligne 115

déjà ça ira mieux

**Nimegue23** · 20/07/2021, 08h34

Malgré un commentaire il m'envoie toujours le message d'erreur

**tee_grandbois** · 20/07/2021, 15h05

bonjour,
d'après ce lien la syntaxe est : rst("nomduchamp") mais c'est bizarre que l'erreur ne soit pas détecté en ligne 114

erreur vbscript 80020009 [Toutes versions]

VBA Access

Vue hybride

Discussions similaires

Partager

Partager