Bonjour,

Je cherche à envoyer des commandes dans une fenetre DOS.
J'ai lu le FAQ et le forum VBA mais je n'arrive pas à adapter la solution.
Voici ce à quoi je suis parvenu :

Fonction qui permet de créer un fichier .bat pour enregistrer les commandes à envoyer :

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
Function soustestFTP()
Dim Repertoire As String
 
        Repertoire = CurrentProject.Path
        Repertoire = CStr(Repertoire)
 
        Open Repertoire + "\LoaderSession.bat" For Output As #1
 
        Print #1, "cd.."              'retour repertoire
        Print #1, "cd.."              'retour repertoire
 
        Close #1
 
        Sleep 1000
 
Call TestFTP(Repertoire)
End Function
Ce code permet de lancer la fonction Shell

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
 
Public Function TestFTP(stSCRFile As String)
Dim stSysDir As String
    stSysDir = Environ$("COMSPEC")
    stSysDir = Left$(stSysDir, Len(stSysDir) - Len(Dir(stSysDir)))
    Call ShellAndWaitForTermination(stSysDir & "cmd.exe -s" & stSCRFile, vbMaximizedFocus, , 5000)
 
End Function
Voici la fonction shell

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
 
Public Function ShellAndWaitForTermination( _
        sShell As String, _
        Optional ByVal eWindowStyle As VBA.VbAppWinStyle = vbNormalFocus, _
        Optional ByRef sError As String, _
        Optional ByVal lTimeOut As Long = 3600 _
    ) As Boolean
Dim hProcess As Long
Dim lR As Long
Dim bSuccess As Boolean
Dim Second As Long
 
On Error GoTo ShellAndWaitForTerminationError
 
    hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, Shell(sShell, eWindowStyle))
    If (hProcess = 0) Then
        'Impossible de lancer la ligne de commande!
        sError = "Le programme n'a pu être lancé, vérifiez votre ligne de commande."
    Else
        bSuccess = True
        Second = 0
        Do
            'Récupération du statut du process,
            'on vérifie s'il est terminé (lR = 0).
            GetExitCodeProcess hProcess, lR
            'Pause en attendant la fin de notre commande sans
            'géner l'execution des autres process.
            If Second <= lTimeOut Then
                DoEvents: Sleep 6000
                Second = Second + 1
            Else
                'Trop long!
                Call TerminateProcess(hProcess, lR)
                Call CloseHandle(hProcess)
                sError = "Trop long: Le process a été stoppé...."
                lR = 0
                bSuccess = False
            End If
        Loop While lR = STILL_ACTIVE
    End If
 
    ShellAndWaitForTermination = bSuccess
 
    Exit Function
 
ShellAndWaitForTerminationError:
    sError = Err.DESCRIPTION
    Exit Function
End Function
Problème :
La fenetre MSDOS s'ouvre bien avec un repertoire par défault mais impossible d'envoyer les commandes en automatique (cd.. etc)

Pouvez-vous m'aider !

Merci de votre aide