web-dev-qa-db-fra.com

Capturer la valeur de sortie d'une commande Shell dans VBA?

Trouvé cette fonction http://www.cpearson.com/Excel/ShellAndWait.aspx

Mais il faudrait aussi capturer la sortie de la sortie de Shell. Une suggestion de code?

shellvba
24
user310291

Vous pouvez CreateProcess l'application rediriger sa StdOut vers un tuyau, puis lire ce tuyau directement; http://Pastebin.com/CszKUpNS

dim resp as string 
resp = redirect("cmd","/c dir")
resp = redirect("ipconfig","")
20
Alex K.

D'après la réponse d'Andrew Lessard, voici une fonction permettant d'exécuter une commande et de renvoyer le résultat sous forme de chaîne - 

Public Function ShellRun(sCmd As String) As String

    'Run a Shell command, returning the output as a string

    Dim oShell As Object
    Set oShell = CreateObject("WScript.Shell")

    'run command
    Dim oExec As Object
    Dim oOutput As Object
    Set oExec = oShell.Exec(sCmd)
    Set oOutput = oExec.StdOut

    'handle the results as they are written to and read from the StdOut object
    Dim s As String
    Dim sLine As String
    While Not oOutput.AtEndOfStream
        sLine = oOutput.ReadLine
        If sLine <> "" Then s = s & sLine & vbCrLf
    Wend

    ShellRun = s

End Function

Usage:

MsgBox ShellRun("dir c:\")
41
Brian Burns

Vous pouvez toujours rediriger la sortie du shell vers un fichier, puis lire la sortie du fichier.

5
Lance Roberts

Sur la base de la réponse de bburns.km , j'ai ajouté le fait de passer une entrée (à l'aide de StdInput) à l'exécutable pendant l'appel. Juste au cas où quelqu'un tomberait dessus et aurait le même besoin.

''' <summary>
'''   Executes the given executable in a Shell instance and returns the output produced
'''   by it. If iStdInput is given, it is passed to the executable during execution.
'''   Note: You must make sure to correctly enclose the executable path or any given
'''         arguments in quotes (") if they contain spaces.
''' </summary>
''' <param name="iExecutablePath">
'''   The full path to the executable (and its parameters). This string is passed to the
'''   Shell unaltered, so be sure to enclose it in quotes if it contains spaces.
''' </param>
''' <param name="iStdInput">
'''   The (optional) input to pass to the executable. Default: Null
''' </param>
Public Function ExecuteAndReturnStdOutput(ByVal iExecutablePath As String, _
                                       Optional ByVal iStdInput As String = vbNullString) _
                As String

   Dim strResult As String

   Dim oShell As WshShell
   Set oShell = New WshShell

   Dim oExec As WshExec
   Set oExec = oShell.Exec(iExecutablePath)

   If iStdInput <> vbNullString Then
      oExec.StdIn.Write iStdInput
      oExec.StdIn.Close    ' Close input stream to prevent deadlock
   End If

   strResult = oExec.StdOut.ReadAll
   oExec.Terminate

   ExecuteAndReturnStdOutput = strResult

End Function

Remarque: Vous devrez ajouter une référence à Windows Script Host Object Model pour que les types WshShell et WshExec soient connus.
(Pour ce faire, accédez à Extras -> Références dans la barre de menus de VBA IDE.)

4
Marcus Mangelsdorf
Sub StdOutTest()
    Dim objShell As Object
    Dim objWshScriptExec As Object
    Dim objStdOut As Object
    Dim rline As String
    Dim strline As String

    Set objShell = CreateObject("WScript.Shell")
    Set objWshScriptExec = objShell.Exec("c:\temp\batfile.bat")
    Set objStdOut = objWshScriptExec.StdOut

    While Not objStdOut.AtEndOfStream
        rline = objStdOut.ReadLine
        If rline <> "" Then strline = strline & vbCrLf & CStr(Now) & ":" & Chr(9) & rline
       ' you can handle the results as they are written to and subsequently read from the StdOut object
    Wend
    MsgBox strline
    'batfile.bat
    'ping 1.1.1.1 -n 1 -w 2000 > nul
    'echo 2
    'ping 1.1.1.1 -n 1 -w 2000 > nul
    'echo 4
    'ping 1.1.1.1 -n 1 -w 2000 > nul
    'echo 6
    'ping 1.1.1.1 -n 1 -w 2000 > nul
    'echo 8
End Sub
3
Andrew Lessard

Cette fonction fournit un moyen rapide d'exécuter une commande en ligne de commande à l'aide de l'objet presse-papiers:

Capturer la sortie en ligne de commande:

Function getCmdlineOutput(cmd As String)
    CreateObject("WScript.Shell").Run "cmd /c """ & cmd & "|clip""", 0, True 'output>clipbrd
    With CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") 'latebound clipbrd obj
        .GetFromClipboard                                 'get cmdline output from clipboard
        getCmdlineOutput = .GetText(1)                    'return clipboard contents
    End With
End Function

Exemple d'utilisation:

Sub Demo1()
    MsgBox getCmdlineOutput("w32tm /tz")  'returns the system Time Zone information
End Sub

Il utilise la commande WShell Run car il autorise éventuellement une exécution asynchrone, ce qui signifie qu'il attendra que la commande se termine avant que VBA ne continue, ce qui est important pour l'implication du presse-papiers.

Il utilise également un utilitaire de ligne de commande intégré mais souvent oublié, appelé clip.exe , dans ce cas en tant que destination pour la sortie canalisée cmdline.

La manipulation du Presse-papiers nécessite une référence à la bibliothèque Microsoft Forms 2.0, créée dans ce cas avec une référence Late-bound (qui a un aspect différent, car MS Forms - aka fm20.dll - est un fichier Windows bibliothèque, pas VBA).

Conservation des données du Presse-papiers existantes:

Dans mon cas, il était problématique que la fonction ci-dessus efface les données du Presse-papiers existantes. La fonction ci-dessous est donc modifiée pour conserver et remplacer le texte existant dans le Presse-papiers.

S'il y a autre chose que du texte dans le presse-papiers, vous serez averti qu'il sera perdu. Certains codages lourds pourraient permettre de renvoyer d'autres types de données du presse-papiers ... mais la manipulation avancée du presse-papiers est bien plus complexe que ne le réalisent la plupart des utilisateurs, et je n'ai franchement pas le besoin ni le désir d'y entrer. Plus d'infos ici .

Notez que dans cette méthode, MS Forms est Early-Bound mais peut être modifié si vous le souhaitez. (Mais rappelez-vous en règle générale, la liaison tardive généralement double temps de traitement.)

Function getCmdlineOutput2(cmd As String)
'requires Reference: C:\Windows\System32\FM20.DLL (MS Forms 2.0) [Early Bound]
    Dim objClipboard As DataObject, strOrigClipbrd As Variant
    Set objClipboard = New MSForms.DataObject   'create clipboard object
    objClipboard.GetFromClipboard               'save existing clipboard text

    If Not objClipboard.GetFormat(1) Then
        MsgBox "Something other than text is on the clipboard.", 64, "Clipboard to be lost!"
    Else
        strOrigClipbrd = objClipboard.GetText(1)
    End If

    'Shell to hidden commandline window, pipe output to clipboard, wait for finish
    CreateObject("WScript.Shell").Run "cmd /c """ & cmd & "|clip""", 0, True
    objClipboard.GetFromClipboard               'get cmdline output from clipboard
    getCmdlineOutput2 = objClipboard.GetText(1) 'return clipboard contents
    objClipboard.SetText strOrigClipbrd, 1      'Restore original clipboard text
    objClipboard.PutInClipboard
End Function

Exemple d'utilisation:

Sub Demo2()
    MsgBox getCmdlineOutput2("dir c:\")  'returns directory listing of C:\
End Sub
0
ashleedawg