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
| if (actionName = "OpenReview") then
dim check, activeTSTestID, reviewTSTest, reviewFile, reviewAtt, isNewReview, reviewType
' // start check block //
on error resume next
check = false
' check if a valid review test instance is selected
activeTSTestID = TestSetTest_Fields.Field("TC_TESTCYCL_ID").Value
if isEmpty(activeTSTestID) then Err.Number = -1
ErrorMsg = "No review test selected. Please select one first."
check = (Err.Number = 0)
' check if test is a review test
if check then
set reviewTSTest = TDConnection.TSTestFactory.Item(activeTSTestID)
if not QCHelper.isReview(reviewTSTest) then Err.Number = -1
ErrorMsg = "Selected item is not a review."
check = (Err.Number = 0)
end if
' check the review type
if check then
set test = reviewTSTest.Test
reviewType = Mid(test.Field("TS_USER_22"), 13)
if not Len(reviewType) > 0 then Err.Number = -1
ErrorMsg = "Cannot read the review type. Please contact your administrator."
check = (Err.Number = 0)
end if
if check then
if reviewTSTest.Test.GetCoverList().Count <= 0 then Err.Number = -1
ErrorMsg = "The selected review has no requirement coverage."
check = (Err.Number = 0)
end if
' try to lock the review
if check then
Dev_DebugMsg "Lock review"
reviewTSTest.LockObject
if Err.Number <> 0 and Left(Err.Description, 23) = "The Object is locked by" then
ErrorMsg = "Review is locked by another user." & vbCrLf & Err.Description
elseif Err.Number <> 0 or not reviewTSTest.isLocked then
Err.Number = -1
ErrorMsg = "Review cannot be locked. Please contact your administrator."
end if
check = (Err.Number = 0)
end if
' check if project properties are valid
if check then
if not Len(Trim(getProjectSetting("BENr"))) > 0 or _
not Len(Trim(getProjectSetting("CustomerGroup"))) > 0 or _
not Len(Trim(getProjectSetting("Vehicle"))) > 0 then
ErrorMsg = "One of the project properties 'Customer Group', 'Vehicle', 'BE-Number' isn't valid." & vbCrLf & _
"Please correct at the following dialog..."
MsgBox ErrorMsg, 48, "Error"
ShowPjctProperties
ErrorMsg = ""
Err.Number = 0
end if
if not Len(Trim(getProjectSetting("BENr"))) > 0 or _
not Len(Trim(getProjectSetting("CustomerGroup"))) > 0 or _
not Len(Trim(getProjectSetting("Vehicle"))) > 0 then
Err.Number = -1
end if
ErrorMsg = "One of the project properties is still not valid. Please try again."
check = (Err.Number = 0)
end if
' check if review template exists
if check then
if not fso.FileExists(REVIEW_TEMPLATE_FILE) then Err.Number = -1
ErrorMsg = "Cannot find the Review Template File. Please contact your administrator."
check = (Err.Number = 0)
end if
' get review file
if check then
' search for attachment review file
set reviewAtt = nothing
set attlist = reviewTSTest.Attachments.NewList("")
if attlist.count > 0 then
if attlist.count > 1 then
dev_debugmsg("Warning: There are more then one attachments at review '" & reviewTSTest.TestName & "'. Open first one...")
end if
for each att in attlist
if Left(UCase(att.Name(1)), 2) = "R_" and Right(UCase(att.Name(1)), 4) = ".XLS" then
set reviewAtt = att
exit for
end if
next
end if
reviewPath = REVIEW_PATH & Year(Now) & "." & Month(Now) & "." & Day(Now) & "." & _
Hour(Now) & "." & Minute(Now) & "." & Second(Now) & "\"
if not isNothing(reviewAtt) then
' Review present -> download from project
isNewReview = false
reviewFile = reviewAtt.Name
reviewAtt.AttachmentStorage.ClientPath = reviewPath
reviewAtt.load true, ""
else
on error goto 0
' Review not present -> add new one from template
isNewReview = true
reviewTSTestTestName = reviewTSTest.TestName
if Len(reviewTSTestTestName) > 61 then reviewTSTestTestName = Left(reviewTSTestTestName,60)
reviewFile = reviewTSTestTestName & ".xls"
if not fso.FolderExists(reviewPath) then fso.CreateFolder(reviewPath)
fso.CopyFile REVIEW_TEMPLATE_FILE, reviewPath & reviewFile
end if
if not fso.FileExists(reviewPath & reviewFile) then Err.Number = -1
ErrorMsg = "Cannot read review file. Please contact your administrator."
check = (Err.Number = 0)
end if
if not check and ErrorMsg <> "" then
MsgBox ErrorMsg, 48, "Error"
' ensure the review object get unlocked after any error
if isObject(reviewTSTest) and not isNothing(reviewTSTest) then reviewTSTest.UnLockObject
end if
if Dev_isDevMode then on error goto 0
' // end check block //
if check then
FileName = reviewPath & reviewFile
if isNewReview then
sReviewType = reviewType
BENumber = "BE-" & getProjectSetting("BENr")
Customer = getProjectSetting("CustomerGroup")
Project = getProjectSetting("Vehicle")
ExaminationObject = reviewTSTest.Test.GetCoverList().Item(1).Name
Author = TDConnection.UserName
StartDate = Day(Now) & "." & Month(Now) & "." & Year(Now)
dev_debugmsg "Start new review..."
ATCOM.ExcelReview.NewReview FileName, sReviewType, BENUmber, Customer, _
Project, ExaminationObject, Author, StartDate
else
dev_debugmsg "Open review..."
ATCOM.ExcelReview.OpenReview(FileName)
end if
if ATCOM.ExcelReview.isReviewSaved then
if not isNothing(reviewAtt) then
' update presented review attachment
dev_debugmsg "update presented review attachment"
reviewAtt.save true
else
' add new review attachment
dev_debugmsg "add new review attachment"
set reviewAtt = reviewTSTest.Attachments.AddItem(Null)
' if Len(reviewFile) > 70 then
'MsgBox "1"
' reviewFile = Left(reviewFile,60) & ".xls"
' end if
name = reviewPath & reviewFile
' cut name to max 236 characters because of DB and NTFS limitation to 255 chars
' qc puts some internal chars like 'TESTCYCL_467_<FileName>' to the name so we cut it to the maximum 240 - 4 (FileExt)
if Len(name) > 236 then name = Left(name, 236)
reviewAtt.FileName = name
reviewAtt.Type = TDATT_FILE
'MsgBox "2"
' reqName = Mid(name,1,60)
' reviewAtt.FileName = reqName
' reviewAtt.Type = TDATT_FILE
reviewAtt.Post
' else
'MsgBox "3"
'end if
end if
' update review status
select case ATCOM.ExcelReview.ReviewStatus
case "finished"
TestSetTest_Fields.Field("TC_STATUS").Value = "Passed"
Actions.Action("RfrshAct").Execute
end select
end if
end if
' ensure the review object get unlocked at the end
if isObject(reviewTSTest) and not isNothing(reviewTSTest) then reviewTSTest.UnLockObject
dev_debugmsg "Review finished | UnLock review"
on error goto 0
end if |
vbscript exécuter une partie du script en arrière plan
Répondre avec citation
Ne pas oublier le tag 
si satisfait.
Voter pour toute réponse satisfaisante avec 
pour encourager les intervenants.
Partager