この関数を見つけました http://www.cpearson.com/Excel/ShellAndWait.aspx
ただし、シェル出力から出力をキャプチャする必要もあります。コードの提案はありますか?
CreateProcess
がアプリケーションにStdOut
をパイプにリダイレクトし、そのパイプを直接読み取ることができます。 http://Pastebin.com/CszKUpNS
dim resp as string
resp = redirect("cmd","/c dir")
resp = redirect("ipconfig","")
Andrew Lessardの答えに基づいて、コマンドを実行し、出力を文字列として返す関数を次に示します-
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
使用法:
MsgBox ShellRun("dir c:\")
シェル出力を常にファイルにリダイレクトし、ファイルから出力を読み取ることができます。
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
bburns.km's answer に基づき、呼び出し中に実行可能ファイルに(StdInputを使用して)入力を渡すことを追加しました。誰かがこれにつまずいて、同じニーズを持っている場合に備えて。
''' <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
注:
Windows Script Host Object Model
への参照を追加する必要があります。そのため、タイプWshShell
とWshExec
は知られています。
(これを行うには、VBA IDEのメニューバーのExtras->Referencesに移動します。)
主にBrian Burnsからのさまざまな回答に基づいて、テスト済みで機能する短縮バージョンを以下に示します。
Function F_shellExec(sCmd As String) As String
Dim oShell As New WshShell 'requires ref to Windows Script Host Object Model
F_shellExec = oShell.Exec(sCmd).StdOut.ReadAll
End Function
それはかなりうまく機能し、非常に高速です。ただし、出力が大きすぎる場合(たとえば、C:ドライブ全体をスキャンするsCmd = "DIR /S C:\"
)、ReadAll
willl crash
だから、私は2番目の解決策を思いついたが、どちらの場合もこれまでのところうまくいく。最初の読み取りが高速であり、クラッシュした場合、読み取りが最初から再開されるため、情報を見逃さないことに注意してください。
Function F_shellExec2(sCmd As String) As String
'Execute Windows Shell Commands
Dim oShell As New WshShell 'requires ref to Windows Script Host Object Model
'Dim oExec As WshExec 'not needed, but in case you need the type
Dim oOutput As TextStream
Dim sReturn As String
Dim iErr As Long
'Set oExec = oShell.Exec(sCmd) 'unused step, for the type
Set oOutput = oShell.Exec(sCmd).StdOut
On Error Resume Next
sReturn = oOutput.ReadAll
iErr = Err.Number
On Error GoTo 0
If iErr <> 0 Then
sReturn = ""
While Not oOutput.AtEndOfStream
sReturn = sReturn & oOutput.ReadLine & Chr(10)
Wend
End If
F_shellExec2 = sReturn
End Function
この関数は、クリップボードオブジェクトを使用して、コマンドラインコマンドを実行する簡単な方法を提供します。
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
Sub Demo1()
MsgBox getCmdlineOutput("w32tm /tz") 'returns the system Time Zone information
End Sub
WShell Run
command を使用します。これは、オプションで非同期実行を許可するためです。つまり、VBAが続行する前にコマンドの実行が完了するまで待機します。
また、 clip.exe
。この場合、パイプcmdline出力の宛先として。
クリップボード操作には、Microsoft Forms 2.0ライブラリへの参照が必要です。この場合、Late-boundで作成しました参照(MS Formsから異なるように見えます-別名 fm20.dll
-Windowsライブラリであり、VBAではありません)。
私の場合、上記の関数が既存のクリップボードのデータを消去することが問題であったため、以下の関数を変更して、クリップボード上の既存のテキストを保持および置換します。
クリップボードにテキスト以外のものがある場合、失われることを警告されます。いくつかの重いコーディングにより、他の/任意のタイプのクリップボードデータを返すことができます...しかし、高度なクリップボード操作は、ほとんどのユーザーが理解するよりもはるかに複雑であり、率直に言って、それに入る必要も欲望もありません。詳細 こちら 。
このメソッドでは、MS FormsはEarly-Boundですが、必要に応じて変更できます。 (ただし、一般的な経験則として、一般的にdoublesの処理時間を遅らせます。)
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
Sub Demo2()
MsgBox getCmdlineOutput2("dir c:\") 'returns directory listing of C:\
End Sub