-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathservice_EDF.vbs
182 lines (142 loc) · 5.24 KB
/
service_EDF.vbs
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
' F3_TEST REFERENCIEL
'
' Fill depending entry field after changes to the selection field (1. field)
'
'
Option Explicit
On Error Goto 0
'------------------------------------------------------------------------------
' Consts
'------------------------------------------------------------------------------
Const adStateClosed = 0 'Indicates that the object is closed.
Const adStateOpen = 1 'Indicates that the object is open.
Const adStateConnecting = 2 'Indicates that the object is connecting.
Const adStateExecuting = 4 'Indicates that the object is executing a command.
Const adStateFetching = 8 'Indicates that the rows of the object are being retrieved.
'------------------------------------------------------------------------------
' Definitions
'------------------------------------------------------------------------------
Dim tab, xls, cs, Conn
tab= "CORB_Pilote_EDF"
xls= "C:\Program Files (x86)\JuK\DpuScan\UDD\CORB_Pilote_EDF.xlsx"
cs = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source="+xls+";Extended Properties='Excel 12.0 Xml;HDR=YES'"
Set Conn= nothing
'------------------------------------------------------------------------------
' EntryPoint
'------------------------------------------------------------------------------
'%(D.SMARTGEC_PRENOM) = "prenom quelconque"
' essai de dalil *******************/
Function ExtFunction (REF_BENEF)
Dim arRet(2) ' Array for the return values
Dim res
res= GetRecord (REF_BENEF,cs,"","",tab)
arRet(0)="[84]" ' Special command 84 "Fill the UDD, start with next line"
arRet(1)="||*||*||*||*||code corbeil |"+res(1)+"||*||*||*||*||*||*||*||*||*"
'MsgBox arRet(1)
ExtFunction=arRet 'Assign the array
' debug de dalil *******************/
' MsgBox " vF3Arg = " & vF3Arg
' MsgBox "Le contenu de ExtFunction! 2 -> " + "|code corbeil = "+res(1)+"||*||"
' essai de dalil *******************/
End Function
'------------------------------------------------------------------------------
' XLS-Query by DB functions
'------------------------------------------------------------------------------
Function GetRecord (IREF_BENEF,cs,user,pass,table)
dim sql, oRs
Dim i,res(20)
' MsgBox "IREF_BENEF = "+IREF_BENEF
On Error Resume Next
For i=0 TO UBOUND(res)
res(i)= ""
Next
Err.Clear
If Conn Is nothing Then Set Conn = CreateObject("ADODB.Connection")
If (Conn.State And adStateOpen) <> adStateOpen Then
Conn.Open cs, user, pass
End If
If Err.Number <> 0 Then
MsgBox Err.Description
Else
'sql= "SELECT * FROM ["+table+"$] WHERE NOM ='" & IREF_BENEF & "'"
sql= "SELECT * FROM ["+table+"$] WHERE LIBELLE_CORBEILLE ='" & IREF_BENEF &"'"
'MsgBox "la requette sql contien: "&sql
'MsgBox sql,,"SQL"
Err.Clear
set oRs= Conn.Execute(sql)
If Err.Number <> 0 Then
'MsgBox Err.Description,,"Error"
MsgBox " on a une erreur ici de type : "&Err.Description
Else
If IsObject(oRs) Then
'MsgBox " l'objet oRs : "
If oRs.Fields.Count > 1 Then
If 1=1 Then
'MsgBox "email : "+ oRs(4).Value + "nom :" + oRs("2").Value
'MsgBox oRs(4).Value
IF Not IsNull(oRs(0).Value) Then res(0)= CStr(oRs(0).Value) ' Identifiant
IF Not IsNull(oRs(4).Value) Then res(1)= CStr(oRs(3).Value) ' code corbeil
res(2)="" ' code corbeil
'IF Not IsNull(oRs(3).Value) Then res(2)= CStr(oRs(3).Value) ' nom
'IF Not IsNull(oRs(16).Value) Then res(3)= CStr(oRs(16).Value) ' 2eme Identifian
Else
Dim f
For each f in oRs.Fields
MsgBox "Key=" & f.Name & " --- Value=" & f.Value
Next
End If
Else
End If
'MsgBox " l'oRs n'est pas un objet: "
set oRs= Nothing
End If
End If
'MsgBox " on ferme la connexion: "
Conn.Close
End If
' MsgBox Join(res,vbCrLf)
GetRecord= res
End Function
'-------------------------------------------------------------------------------
' EntryFunction for ScriptDLL inserted by DpuScan at mer., 07.02.2024 13:24
'-------------------------------------------------------------------------------
Const UDD_F3_KEY = 1
Const UDD_FIELD_ENTER = 2
Const UDD_FIELD_LEAVE = 3
Const UDD_DIALOG_OPEN = 4
Const UDD_DIALOG_CLOSE = 5
Dim gF3Event 'Global variable for use in EntryPoint
Dim vF3Arg 'Global variable for use in EntryPoint
Function ExtFunctionWrapper(vF3Arg,vF3Event)
'$$ DPUSCAN_DECLARATION_BEGIN
'$$ MODE Process
'$$ VAR vF3Arg = %(D.SMARTGEC_LCORB)
'$$ VAR vF3Event = %(V.F3Event)
'$$ VAR ExtFunctionWrapper = %(V.F3Res), %(V.F3Arg)
'$$ DPUSCAN_DECLARATION_END
Dim vF3Res
Dim res
' debug de dalil *******************/
' MsgBox "Le contenu de de la fonction ExtFunctionWrapper 1 vF3Arg = " & vF3Arg & " vF3Event = " & vF3Event
' essai de dalil *******************/
'Convert to number and make it global
gF3Event = CInt(vF3Event)
Select Case gF3Event
Case UDD_F3_KEY
' Insert your code here ...
Case UDD_FIELD_ENTER
Case UDD_FIELD_LEAVE
Case UDD_DIALOG_OPEN
Case UDD_DIALOG_CLOSE
End Select
res = ExtFunction(vF3Arg)
If IsArray(res) Then
If UBound(res)>0 Then
vF3Res = ""
vF3Arg = res(0) & res(1)
End If
Else
vF3Res = res
End If
ExtFunctionWrapper = Array( vF3Res, vF3Arg )
End Function