Discussion :

[ibdiak]

Bonjour,

Je cherche à exécuter un programme Vbs qui m'a été transmis pour lancer un programme en automatique, mais le code ne fonctionne pas ou ne s'exécute pas .Je n'ai pas de message d'erreur, J'ai juste le prog qui veut s'ouvrir mais qui se ferme aussitôt.
Apparemment c'est un code VB mais je ne suis que débutant dans ce type de langage, je ne comprends donc pas tout le programme écrit .

Si quelqu'un peut m'aider sur ce sujet svp!

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
 
Option Explicit
Dim app
 
Call dowork
 
'shut down the app
If not (app Is Nothing) Then
    app.Quit
    Set app = Nothing
End If
 
 
Sub dowork()
    On Error Resume Next
    '----
    ' Start up Enterprise Guide using the project name
    '----
    Dim prjName
    Dim prjObject
 
    prjName = "C:\Users\Bureau\Dossier\table.egp"    'Project Name
 
    Set app = CreateObject("SASEGObjectModel.Application.7.1")
    If Checkerror("CreateObject") = True Then
        Exit Sub
    End If
 
    '-----
    ' open the project
    '-----
    Set prjObject = app.Open(prjName,"")
    If Checkerror("app.Open") = True Then
        Exit Sub
    End If
 
 
    '-----
    ' run the project
    '-----
    prjObject.run
    If Checkerror("Project.run") = True Then
        Exit Sub
    End If
 
 
    '-----
    ' Save the new project
    '-----
    prjObject.Save
    If Checkerror("Project.Save") = True Then
        Exit Sub
    End If
 
    '-----
    ' Close the project
    '-----
    prjObject.Close
    If Checkerror("Project.Close") = True Then
        Exit Sub
    End If
 
End Sub
 
Function Checkerror(fnName)
    Checkerror = False
 
    Dim strmsg
    Dim errNum
 
    If Err.Number <> 0 Then
        strmsg = "Error #" & Hex(Err.Number) & vbCrLf & "In Function " & fnName & vbCrLf & Err.Description
        'MsgBox strmsg  'Uncomment this line if you want to be notified via MessageBox of Errors in the script.
        Checkerror = True
    End If
 
End Function
 
Merci d'avance pour votre aide

[hackoofr]

Décommenter cette ligne pour recevoir les erreurs dans le MsgBox 'MsgBox strmsg 'Uncomment this line if you want to be notified via MessageBox of Errors in the script.

MsgBox strmsg

[hackoofr]

Avec ce code modifié, vous pouvez récuperer les erreurs dans un fichiers texte aussi :

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
Option Explicit
Const ForWriting = 2
Dim app,fso,ErrorFile
ErrorFile = Left(Wscript.ScriptFullName,InstrRev(Wscript.ScriptFullName, ".")) & "txt"
Call dowork
'-------------------------------
Sub dowork()
    On Error Resume Next
'----
' Start up Enterprise Guide using the project name
'----
    Dim prjName
    Dim prjObject
    prjName = "C:\Users\Bureau\Dossier\table.egp"    'Project Name
    Set app = CreateObject("SASEGObjectModel.Application.7.1")
    If Checkerror("CreateObject") = True Then
        Exit Sub
    End If
'-----
' open the project
'-----
    Set prjObject = app.Open(prjName,"")
    If Checkerror("app.Open") = True Then
        Exit Sub
    End If
'-----
' run the project
'-----
    prjObject.run
    If Checkerror("Project.run") = True Then
        Exit Sub
    End If
'-----
' Save the new project
'-----
    prjObject.Save
    If Checkerror("Project.Save") = True Then
        Exit Sub
    End If
'-----
' Close the project
'-----
    prjObject.Close
    If Checkerror("Project.Close") = True Then
        Exit Sub
    End If
'-------------------------------
'shut down the app
    If not (app Is Nothing) Then
        app.Quit
        Set app = Nothing
    End If
End Sub
'-------------------------------
Function Checkerror(fnName)
    Checkerror = False
    Dim strmsg
    Dim errNum
    If Err.Number <> 0 Then
        strmsg = "Error #" & Hex(Err.Number) & vbCrLf & "In Function " & fnName & vbCrLf & Err.Description
        'Uncomment this line if you want to be notified via MessageBox of Errors in the script.
        MsgBox strmsg,vbCritical,"Error #" & Hex(Err.Number) 
        Call WriteError(strmsg,ErrorFile)
        Checkerror = True
    End If
End Function
'-------------------------------
Sub WriteError(strText,ErrorFile)
    Dim fs,ts 
    Const ForWriting = 2
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set ts = fs.OpenTextFile(ErrorFile,ForWriting,True)
    ts.WriteLine strText
    ts.Close
End Sub
'----------------------------------

[ibdiak]

Hackoofr,

J'ai un message d'erreur qui apparaît et qui affiche ce message

Error #800403F2
In Function Project.Save
Echec de l'enregistrement de C:\Users\Bureau\Dossier\Table.egp. Cause : Impossible d'enregistrer le projet "Table" car il est en lecture seule.
SAS.EG.ProjectElements
Boolean Save(Boolean, Boolean)
à SAS.EG.ProjectElements.ProjectCollection.Save(Boolean resetModified, Boolean forRecovery)
à SAS.EG.Scripting.Project.Save()

je ne comprends pas pourquoi il parle d'erreur d'échec d'enregistrement car le programme est bien fermé .
est ce qu'il n'y aurait pas d'erreur dans mon programme?

[ibdiak]

Finalement j'ai pu résoudre le souci , il fallait juste créer un chemin de sortie. Merci