Translate

2013年6月9日 星期日

[VBA] Send Commands to shell with Timeout

https://github.com/walter426/VbaUtilities/blob/master/ShellUtilities.bas

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

Dim CmdTxt As String

CmdTxt =  line1 & vbCrLf & _
                  line2 & vbCrLf & _
                  ""
    
oShell.Run ("cmd.exe")
Sleep 1000
   
FailedReason = Shell_SendKeysWithTimeout(oShell, CmdTxt, 1000)


Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Public Function Shell_SendKeysWithTimeout(oShell As Object, CmdTxt As String, Timeout As Integer) As String
    On Error GoTo Err_Shell_SendKeysWithTimeout
    
    Dim FailedReason As String
    
    
    Dim CmdSet As Variant
    CmdSet = SplitStrIntoArray(CmdTxt, Chr(10))
    
    Dim cmd_idx As Integer
    
    For cmd_idx = 0 To UBound(CmdSet)
        If CmdSet(cmd_idx) = "" Then
            GoTo Next_Shell_SendKeysWithTimeout
        End If
        
        
        With oShell
            .SendKeys (CmdSet(cmd_idx) & vbCrLf)
            Sleep Timeout
        End With 'oShell
        
Next_Shell_SendKeysWithTimeout:
    Next cmd_idx


Exit_Shell_SendKeysWithTimeout:
    Shell_SendKeysWithTimeout = FailedReason
    Exit Function

Err_Shell_SendKeysWithTimeout:
    MsgBox Err.Description
    Resume Exit_Shell_SendKeysWithTimeout
    
End Function

Ref:
SplitStrIntoArray:
http://waltertech426.blogspot.hk/2013/06/vba-split-string-and-trim-space.html

沒有留言:

張貼留言