Results 1 to 14 of 14

Thread: [VBA] Run Application - Capture Output

  1. #1

    Thread Starter
    Fanatic Member dmaruca's Avatar
    Join Date
    May 2006
    Location
    Jacksonville, FL
    Posts
    577

    [VBA] Run Application - Capture Output

    This class includes 3 routines for shelling a program in Windows and an optional command-line builder.

    The first 2 routines use shell().
    vb Code:
    1. 'Run an application, returning immediately to the caller.
    2. Public Sub RunApp(Optional cmd As String, Optional intMode As VbAppWinStyle = _
    3.     VbAppWinStyle.vbHide)
    4. 'Run an application, waiting for its completion before returning to the caller.
    5. Public Sub RunAppWait(Optional cmd As String, Optional intMode As VbAppWinStyle = _
    6.     VbAppWinStyle.vbHide)

    The next routine uses api.
    vb Code:
    1. 'Runs an application, waiting for its completion before returning to the caller.
    2. 'Screen output is captured and returned to the caller.
    3. Public Function RunAppWait_CaptureOutput(Optional cmd As String) As String

    The optional command-line builder can be explained using this example. I like to use this a lot for pdftotex.exe. This example shows you how to extract the text from a pdf file without using an intermediate text file. It is FIFO.
    vb Code:
    1. Sub ExtractTextDirect()
    2.     Dim cls As New clsRunApp
    3.     Dim s as String
    4.    
    5.     cls.Command = "C:\Path To\pdftotext.exe"
    6.     cls.AddParamater "-layout" 'preserve the layout of the text
    7.     'Surrounding quotes will be auto-added to this paramater since it has spaces.
    8.     cls.AddParamater "C:\super long path to pdf file\my pdf file.pdf"
    9.     'a hyphen as the next paramater directs output to stdout which we will capture
    10.     cls.AddParamater "-"
    11.    
    12.     s = cls.RunAppWait_CaptureOutput
    13.     Set cls = Nothing
    14.    
    15. End Function

    A note about the auto adding of quotes to paramaters: AddParamater has an optional paramater for using quotes. The default behavior will add quotes around paramaters with spaces, but not add any around paramaters without spaces.

    Code:
    'Use by AddParamater. See procedure header for explanation.
    Public Enum eQuote
        eQuote_Normal
        eQuote_ForceNone
        eQuote_ForceQuotes
    End Enum
    
    eQuote_Normal is discussed above.
    eQuote_ForceNone is for if your paramater has spaces but you do not want it surrounded by quotes.
        Useful for switches like -f 37.
    eQuote_ForceQuotes surrounds the paramater with quotes no matter what.
    
    So if you lump all your switches in one statement use this:
    cls.AddParamater "-o -f 37 -g", eQuote_ForceNone
    The class also has an optional flag for checking if the command exists when you assign it to the Command property. This is useful only if you want your code to fail on the command assignment. Only use this if you provide the full path to the command.

    vb Code:
    1. cls.CheckForCommandNotExist = True
    2. cls.Command = "pdftotext.exe" 'ERROR
    3. cls.Command = "C:\Path To\pdftotext.exe" 'Yes
    4.  
    5. 'Ignore built in command builder. The stored command still exists.
    6. MsgBox cls.RunAppWait_CaptureOutput("netstat /?")

    I've included plenty of built-in error checking and documentationin the class file. Check it out if you want.

    vb Code:
    1. Sub ErrorTest()
    2.     Dim cls As New clsRunApp
    3.    
    4.     On Error Resume Next
    5.     cls.CheckForCommandNotExist = True
    6.     cls.command = "c:\pdftotext.exe"
    7.     If Err.Number = cls.ErrNum(CommandPathNotFound) Then
    8.         MsgBox "pdtotext is not found"
    9.     End If
    10.    
    11.    
    12.     MsgBox cls.RunAppWait_CaptureOutput("klsdj /?")
    13.     If Err.Number = cls.ErrNum(ApiFailure) Then
    14.         MsgBox Replace("Api failure in {0}! ", "{0}", Err.Source) & Err.Description
    15.     End If
    16.    
    17.     'I thought this was cute.
    18.     MsgBox cls.RunAppWait_CaptureOutput("cmd /C echo Test complete.")
    19. End Sub

    You have probably seen these floating around, but I use these routines so often I finally decided to combine them in one place and wrap them in a class with a built-in command builder. Maybe you'll find it useful.

    Edit 2-3-2010:
    A bug was discovered in the CreateProcess call inside RunAppWait_CaptureOutput. This has been repaired.

    Edit 11-14-2012
    Modified to work with xcopy and other programs which require stdin. The copy attached to this post will not work with xcopy. See the update post here.
    Attached Files Attached Files
    Last edited by dmaruca; Nov 14th, 2012 at 04:07 PM.

  2. #2

    Thread Starter
    Fanatic Member dmaruca's Avatar
    Join Date
    May 2006
    Location
    Jacksonville, FL
    Posts
    577

    Re: [VBA] Run Application - Capture Output

    Edit: Bugfix if anyone is subscribed to this thread.

  3. #3
    New Member
    Join Date
    Mar 2011
    Posts
    1

    Re: [VBA] Run Application - Capture Output

    This is very helpful. I am an accountant, trying to tie together various open source command line utilities to improve our firms document management processes. This gets me much closer to my goal!

  4. #4

    Thread Starter
    Fanatic Member dmaruca's Avatar
    Join Date
    May 2006
    Location
    Jacksonville, FL
    Posts
    577

    Re: [VBA] Run Application - Capture Output

    I updated this to work with xcopy. It was failing before because xcopy requires stdin to run. I've also renamed it to CRunApp but works the same as the previous.

    Note: Since this opens up stdin, exe's which prompt for information will put the program into an infinite blocking state waiting for input. Make sure you put the correct switches in place to prevent any prompting. I'm sure this could be modified to accommodate this prompting and even extended to be fully interactive with a console application. To do that you would use WriteFile to write to the hWriteIn handle.

    Looking at old code can sometimes cause me to wince. My style has changed over the years and I have become more experienced with working with API calls. My initial reaction from looking at this is to rewrite it, but it has been running production in so many of my projects for years with no errors I figure why fix what's not broken.

    Here is an example of calling xcopy with this class:

    Code:
    Sub TestCopyFolder()
    	Debug.Print CopyFolder("C:\test folder 1\*", "C:\test folder 2\")
    End Sub
    
    Public Function CopyFolder(SourceWithMask As String, DestinationWithoutMask As String, Optional CopySubdirectories As Boolean = True) As Boolean
        Dim RunApp As New CRunApp
        Dim s As String
    
        With RunApp
            .Command = "cmd.exe /c xcopy.exe"
            .AddParamater "/Q" 'Does not display file names while copying. (this prevents false positives with files name "File(s) copied.txt")
            .AddParamater "/R" 'Overwrites read-only files.
            .AddParamater "/Y" 'Suppresses prompting to confirm you want to overwrite an existing destination file.
            .AddParamater "/I" 'If destination does not exist and copying more than one file, assumes that destination must be a directory.
            .AddParamater "/G" 'Allows the copying of encrypted files to destination that does not support encryption.
            If CopySubdirectories Then
                .AddParamater "/E" 'Copies directories and subdirectories, including empty ones.
            End If
            .AddParamater SourceWithMask
            .AddParamater DestinationWithoutMask
            s = .RunAppWait_CaptureOutput
        End With
    
        CopyFolder = InStr(1, s, "File(s) copied") > 1
    End Function
    I've also added a "CurrentDirectory" parameter which is useful for acting like the command was called from the provided directory. This is useful for creating zip files which have root directories. Here's an example using 7-zip:

    Code:
    Sub TestCreateZip()
    	'Given path "c:\folder to zip\subfolder\*.*" 
    	'This will create a zip file with a root directory "subfolder" inside the zip file. 
    	'The zip file will contain:
    	'subfolder\file1.txt
    	'subfolder\subfolder2\file2.txt etc etc
    	Debug.Print CreateZip(FullZipPath:="C:\New Zip File.zip", _
    		FromFolder:="subfolder\*", _
    		CurrentDirectory:="c:\folder to zip\")
    End Sub
    
    Public Function CreateZip(FullZipPath As String, FromFolder As String, Optional Password, Optional CurrentDirectory As String) As Boolean
        Dim RunApp As New CRunApp
        Dim s As String
        
    On Error GoTo errHandler
    
        With RunApp
            .Command = "C:\7z.exe"
            .AddParamater "a" 'add files switch
            .AddParamater "-aoa" 'Overwrite All existing files without prompt.
            .AddParamater "-y" 'assume yes on all queries
            If Not IsMissing(Password) Then
                .AddParamater "-p" & CStr(Password), eQuote_ForceNone  'you should probably enclose the password in quotes if it has a space
                .AddParamater "-mhe" 'encrypts archive headers 
            End If
            .AddParamater "--" 'prevent further switch parsing
            .AddParamater FullZipPath 'the zip
            .AddParamater FromFolder 'the path/wildcard of the files
            s = .RunAppWait_CaptureOutput(CurrentDirectory:=CurrentDirectory)
        End With
    
        CreateZip = InStr(1, s, "Everything is Ok", vbTextCompare) > 0 
    exitProcedure:
        On Error Resume Next
        Set RunApp = Nothing
        Exit Function
    errHandler:
        Resume exitProcedure
        Resume
    End Function
    Attached Files Attached Files
    Last edited by dmaruca; Nov 14th, 2012 at 04:31 PM.

  5. #5
    New Member
    Join Date
    Aug 2014
    Posts
    2

    Re: [VBA] Run Application - Capture Output

    Hi,

    It's been a while since this post but I hope you're still around on the forums.

    Firstly, thanks for providing this helpful class.

    There is a slight wrinkle when capturing output. I thought I should provide feedback to allow the class to be improved.

    The wrinkle concerns the case where a command has no output. The command I'm running only produces output if there's something to report, otherwise it reports nothing. [It's the Subversion command "svn status".]

    If the command has no output the PeekNamedPipe loop never exits. A simple example of a command that generates no output and simply teminates is "type nul". The following code can be used to run that command with your class:

    Code:
    Public Function TestRunApp() As String
        Dim cmd_output As String
        Dim RunApp As New CRunApp
    
        cmd_output = ""
        
        With RunApp
            .Command = "cmd.exe /c type"
            .AddParamater "nul"
            cmd_output = .RunAppWait_CaptureOutput
        End With
    
        TestRunApp = cmd_output
    End Function
    Calling this code will result in the RunAppWait_CaptureOutput method never exiting as it is stuck in an endless loop.

    I'd speculate that the pipe doesn't close because nothing was sent through it. The solution is to also check whether the process is still running and allow the loop to also end in that case.

    The following code would fix the issue:

    Code:
    capture_complete = False  ' We haven't even started yet
    process_running = True    ' Assume it's running, it'll be rechecked later
    
    Do While Not capture_complete
        If PeekNamedPipe(hRead, ByVal 0, 0, ByVal 0, bAvail, ByVal 0) = 0 Then
            capture_complete = True  ' The pipe peek failed (probably closed)
        Else
        
            DoEvents
            If bAvail Then
                bString = String(bAvail, 0)
                ReadFile hRead, bString, bAvail, bRead, ByVal 0&
                bString = Left(bString, bRead)
                RunAppWait_CaptureOutput = RunAppWait_CaptureOutput & bString
                CloseHandle hWrite
            
            ElseIf Not process_running Then
                capture_complete = True  ' The process previously finished and nothing in pipe so stop capturing
            
            Else
                lngRetval = GetExitCodeProcess(pi.hProcess, lngExitCode)
                If ApiErrorChecker("GetExitCodeProcess", lngRetval, Err.LastDllError, ErrorDesc) Then
                    ErrorCheck_ApiFailure "RunAppWait", ErrorDesc
                End If
                
                If lngExitCode <> STILL_ACTIVE Then
                    ' N.B. Do not exit the loop immediately, set a flag but ensure that the pipe is checked again
                    ' as something may have been added to the pipe since the last check, but prior to the process
                    ' termination
                    process_running = False
                End If
            
                DoEvents  ' Process events before peeking at the pipe again
            End If
        End If
    Loop
    No doubt, this code might benefit from a little tidy-up but I hope it demonstrates the solution.

    I'm still researching this, trying to determine the order of events, at process termination, that is guaranteed. For example, when the process terminates it seems reasonable that the pipe is still active (to allow the remaining content to be read from the connected process). However, could the process be detected as terminated before the command output was available in the pipe? This would be dangerous for this class, since the pipe would need to continue to be checked after the process terminates, but for how long. It seems to me that the time would be arbitary. As it stands, the changes I've described ensure that the pipe will be checked at least 1 more time after the process is detected as terminated. This should ensure that the pipe is flushed before the loop exits.

    Alternatively, the documentation suggests that the pipe is closed on the termination of the process. If that is the case, what happens if we haven't got around to reading the pipe contents prior to termination? How quick does the reading process need to be?

    BTW, I note that there is no reference to a license for your class. Are you happy for it to be freely used? If so, a comment in the class header would be helpful.

    Regards.

  6. #6

    Thread Starter
    Fanatic Member dmaruca's Avatar
    Join Date
    May 2006
    Location
    Jacksonville, FL
    Posts
    577

    Re: [VBA] Run Application - Capture Output

    Hi there. There is no license associated with this code. Do whatever you wish with it.

    I've primarily used this class to do pdf to text conversions and 7zip over the years. I've used it for other things here and there. In my experience once the output is done the process is finished, but I'm sure there are programs written out there that could break this.

    Thanks for posting your update.

  7. #7
    New Member
    Join Date
    Aug 2014
    Posts
    2

    Re: [VBA] Run Application - Capture Output

    Hi,

    Quote Originally Posted by dmaruca View Post
    There is no license associated with this code. Do whatever you wish with it.
    Thanks for the confirmation.

    Quote Originally Posted by dmaruca View Post
    In my experience once the output is done the process is finished,...
    The problem is actually the reverse of this. That is, the process is finished but the (empty) output isn't considered done, so the code waits forever in an endless loop.

    Quote Originally Posted by dmaruca View Post
    Thanks for posting your update.
    No problem. It's the least I could do.

    Regards.

  8. #8
    New Member
    Join Date
    Oct 2013
    Posts
    3

    Re: [VBA] Run Application - Capture Output

    Hello!

    On Office 2013 it is giving me the message:
    Code:
    Run-time error '-2147220504 (800403e8)':
    
    CreatePipe exited with error code(998): Invalid access to memory location.

  9. #9
    New Member
    Join Date
    May 2008
    Posts
    7

    Re: [VBA] Run Application - Capture Output

    Would also like to see a 2013 version of this, I get a 800403e8 automation error. Thanks for any pointers.

  10. #10

    Thread Starter
    Fanatic Member dmaruca's Avatar
    Join Date
    May 2006
    Location
    Jacksonville, FL
    Posts
    577

    Re: [VBA] Run Application - Capture Output

    Hi guys. Sorry, I did not see the message from November. I just tested in my copy of 2013 and it works fine. What version specifically are you using and what command are you trying to run that gives the error? It sounds like the error lies with the API instead of the version of office.

  11. #11
    New Member
    Join Date
    May 2008
    Posts
    7

    Re: [VBA] Run Application - Capture Output

    Quote Originally Posted by dmaruca View Post
    Hi guys. Sorry, I did not see the message from November. I just tested in my copy of 2013 and it works fine. What version specifically are you using and what command are you trying to run that gives the error? It sounds like the error lies with the API instead of the version of office.
    Thanks for getting back It fails even if I try your netstat /? example.
    My VBA (excel 2013) reports VBA 7.1 / Version 1042 7.1.1042

    I'm importing your CLS, adding 'ptrsafe' liberally where VBA complains, and then doing:

    Dim cls As New clsRunApp

    cls.command = "netstat /?"
    MsgBox cls.RunAppWait_CaptureOutput("netstat /?")

    I may well be doing something stupid, I'm the first to admit I don't understand this very well.
    thx

  12. #12

    Thread Starter
    Fanatic Member dmaruca's Avatar
    Join Date
    May 2006
    Location
    Jacksonville, FL
    Posts
    577

    Re: [VBA] Run Application - Capture Output

    I'll try to get to a 64 bit version sometime soon. you have to do more than pointer safe. every pointer has to be a longptr

  13. #13
    New Member
    Join Date
    May 2008
    Posts
    7

    Re: [VBA] Run Application - Capture Output

    Quote Originally Posted by dmaruca View Post
    I'll try to get to a 64 bit version sometime soon. you have to do more than pointer safe. every pointer has to be a longptr
    Thanks. In the meantime I've converted to this:

    cmd = "ipconfig /all"
    Dim objShell, objCmdExec
    Set objShell = CreateObject("WScript.Shell")
    Set objCmdExec = objShell.exec(cmd)
    CommandOutput = objCmdExec.StdOut.ReadAll

  14. #14
    New Member
    Join Date
    Nov 2017
    Posts
    1

    Re: [VBA] Run Application - Capture Output

    Hi dmaruca,

    Any chance to have the 64 bit version of this code please? We recently moved from 32 bit to 64 bit laptops and the script that was initially working perfectly is no longer working.

    Many thanks,
    Joao

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width