Bonjour à tous,
j’essaie d'initialiser des comboBox (listes déroulantes) sous wincc avec des scripts VBS.
Les textes sont stockés dans dans des fichiers textes. Deux listes déroulantes afin de sélectionner une matière selon une catégorie.
Donc la première comboBox permet de sélectionner la catégorie, dont dépendra la seconde comboBox. La première (catégorie) s'initialise au chargement de la vue (Sub OnGenerateScreen()).
Voici le code:
Le script isFolderExists:Code:
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 Sub OnGenerateScreen() 'Lire le fichier texte "intrants-Cat.txt" et affecter chaq'une de ces lignes 'aux lignes de textes de la liste déroulante On Error Resume Next '*** Création des objets File explorer et TextStream Dim fso, folder, file,f,ts,extend, temp folder="C:\SupTools" extend=".txt" file = "Intrants-Cat" & extend temp = isFolderExists(folder) isFileExists folder, file '*** Affectation des textes de la liste déroulante Dim i, nbLine, list, filePath,buf filePath = folder &"\"& file ReadFile folder,file nbLine=SmartTags("nbLine") ToTrace "231-nbFile: ", nbLine Set list = ScreenItems("Liste_cat") ' On créé on objet "liste déroulante" existant!! list.Visible = False list.CountVisibleItems = nbLine For i = 1 To nbLine list.SelectedIndex= i 'list.SelectedText = buf(i) list.SelectedText = SmartTags("Line_"&i) Next list.Index=1 list.Visible = True Set list = Nothing For i = 1 To nbLine SmartTags("Line_"&i)="" Next If Err.Number <> 0 Then ToTrace "OnGenerateScreen erreur n°:",Err.Number ToTrace "ReadFile description erreur :",Err.Description ToTrace "ReadFile context erreur :",Err.Source Err.Clear End If On Error GoTo 0 End Sub
Script isFileExists:Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21 Function isFolderExists(ByVal chemin) Dim fso, f, NewFile On Error Resume Next Set fso = CreateObject("Scripting.FileSystemObject") If Not fso.FolderExists(chemin) Then 'ToTrace " isFolderExist(chemin)", chemin fso.CreateFolder(chemin) isFolderExists=0 Else 'ToTrace "Le dossier exist déjà", 1 'ToTrace " Son chemin:", chemin isFolderExists=1 End If Set fso = Nothing If Err.Number <> 0 Then ToTrace "isFolderExist erreur n°:",Err.Number ToTrace "isFolderExist description erreur :",Err.Description Err.Clear End If On Error GoTo 0 End Function
Et le script ReadFile:Code:
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 Sub isFileExists(ByVal dossier, ByVal fichier) Dim fso, f, NewFile On Error Resume Next Set fso = CreateObject("Scripting.FileSystemObject") ToTrace "chemin:" , dossier & "\" & fichier ToTrace "fso Fileexists: " , fso.FileExists(dossier & "\" & fichier) If Not fso.FileExists(dossier & "\" & fichier) Then If fichier = "Intrants-cat.txt" Then ToTrace " Si absence de Intrants-Cat.txt, alors on le créé.", 1 Set NewFile = fso.CreateTextFile(dossier & "\" & fichier) NewFile.WriteLine("FUMIERS") NewFile.WriteLine("AUTREAGRI") NewFile.WriteLine("BOUES") NewFile.WriteLine("LISIERS") NewFile.WriteLine("MATIERES VEGETALES") NewFile.Close Set NewFile = Nothing 'isFileExists=0 Else Set NewFile = fso.CreateTextFile(dossier & "\" & fichier) NewFile.WriteLine("NOUVEAU") NewFile.Close Set NewFile = Nothing 'isFileExists=0 End If Else 'ToTrace "Le fichier est bien trouvé", "" 'isFileExists=1 End If Set fso = Nothing If Err.Number <> 0 Then ToTrace "*****************************","" ToTrace "IOField invisble sur la sup ********","" ToTrace "isFileExist erreur n°:",Err.Number ToTrace "isFileExist description erreur :",Err.Description ToTrace "","" ToTrace "*****************************","" Err.Clear End If On Error GoTo 0 End Sub
La procédure "ToTrace" me sert à avoir un retour monitor (HMIRuntime.Trace...).Code:
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 Sub ReadFile(ByVal dossier, ByVal fichier) Dim fso, f,ts,filePath, temp, buf, nbFile,i, min, max 'On Error Resume Next Set fso = CreateObject("Scripting.FileSystemObject") filePath = dossier & "\" & fichier ToTrace "Getfile:",filePath isFileExists dossier & "\" , fichier Set f = fso.GetFile(filePath) Set ts = f.OpenAsTextStream(1,-2) buf = Split(ts.ReadAll, vbLf) ToTrace "ReadFile2","." For i=0 To UBound(buf)-1 ToTrace "buf(i): ", buf(i) Next temp = UBound(buf) SmartTags("nbLine").Value=temp For i=LBound(buf) To UBound(buf) SmartTags("Line_"&i+1).Value= buf(i) 'ToTrace "i: ", i 'ToTrace "Line" &i + 1 &": ", SmartTags("Line_"&i+1).Value Next ts.Close 'Une fois qu'on a récupéré les catégories, on ferme le fichier texte. Set ts = Nothing Set f = Nothing Set fso = Nothing If Err.Number <> 0 Then ToTrace "ReadFile","" ToTrace "ReadFile erreur n°:",Err.Number ToTrace "ReadFile description erreur :",Err.Description ToTrace "ReadFile context erreur :",Err.Source Err.Clear End If On Error GoTo 0 End Sub
Ce qui marche:
L'initialisation de la comboBox "catégorie". (on teste si le fichier existe ici en premier).
Ce qui me créé l'erreur, c'est lorsque je veux tester l’existence d'un autre fichier texte dans un autre répertoire.
Je ne comprends pas vraiment l'origine du problème. Mais apparemment ce serait dû au fait qu'une instance fso ne peut pas changer de répertoire...
Ma question: Il y a t'il un moyen de tester et créer un ou plusieurs fichiers textes dans plusieurs répertoires, et comment faire?
Merci d'avance. :)