Solved

VBA - Controlling the Shell function

Posted on 2000-02-25
20
1,745 Views
Last Modified: 2008-02-20
I use VBA code in an Excel workbook to pull in data from unix boxes, which is then reformated/recalculated and emailed to various people.

To pull the data in I use the shell function to run a Perl script, which basically runs an ftp.

My problem is that because the shell function runs asynchronously I need some way of telling the Perl script has completed before allowing my code to continue.

I have been using a work around using a msgbox to halt the code, but I'm sure there must be a better way.

He's an excerpt from my code as an example of what I'm doing.

Sub

day_num = Sheets("WORK").Range("B1")

Dim RetVal, Style, Response
RetVal = Shell("J:\autorec\perl.exe J:\autorec\myperlscript.pl", 1)
Msg = "Was File Transfer Successful ?"
    Style = vbYesNo + vbQuestion
    Response = MsgBox(Msg, Style)
    If Response = vbNo Then
        Sheets("DAY" & day_num).Select
        Exit Sub
    End If

etc...
End Sub

What I would like is the code to run the shell script and then wait until it completes before carrying on, without having the user to intervene in some way.
0
Comment
Question by:toffee
  • 6
  • 4
  • 4
  • +3
20 Comments
 
LVL 44

Expert Comment

by:bruintje
ID: 2560449
Hi toffee,

Nice thing anyway, to use apps like this...

for your question, you could loop round the retval???like

Sub

day_num = Sheets("WORK").Range("B1")

Dim RetVal, Style, Response

RetVal = Shell("J:\autorec\perl.exe J:\autorec\myperlscript.pl", 1)

Do while retval <> a certain condition
  do something (a little animation or something that tells the user to wait)
Loop

you can let this thing stay just to confirm that the file was transferred.

Msg = "Was File Transfer Successful ?"
    Style = vbYesNo + vbQuestion
    Response = MsgBox(Msg, Style)
    If Response = vbNo Then
        Sheets("DAY" & day_num).Select
        Exit Sub
    End If

etc...
End Sub

HTH:O)Bruintje
0
 
LVL 44

Expert Comment

by:bruintje
ID: 2560460
or try the doevents

"Operating System Calls
When Visual Basic calls the operating system, the operating system may return the control even before processing the command completely. Doing so may prevent any macro code that depends on an object generated by the call from running. In the example below, the Shell function starts the Microsoft Word application. If Word is not yet open, any effort to establish a DDE link to it will halt the code. By using DoEvents, your procedure makes sure that an operation, such as Shell, is completely executed before the next macro statement is processed.

Example:
   z% = Shell("WinWord Source.Doc",1)
   DoEvents
   ...
   
"

that  would mean that you can do something like

RetVal = Shell("J:\autorec\perl.exe J:\autorec\myperlscript.pl", 1)
DoEvents
.....etc


HTH:O)Bruintje


0
 

Author Comment

by:toffee
ID: 2562003
Thanks for the help Bruintje

I think you may be putting me on the right path. But I'm still not quite getting the results I'm after.

I've tried using DoEvents but it doesn't seem to work, or at least not in the way I want. When the Shell function starts the perl script it could be 5 mins before the ftp completes. DoEvents just seems to wait until the shell has successfully started the perl.exe, then continues. I need some way of being certain the perl/ftp has completed, before allowing the code to continue.

With your other suggestion I may need a little guidance (I've no formal training I'm just picking this up as I go along).

The RetVal just returns the task ID of the program, which is different every time. What condition should I be testing for?

Thanks again
0
 
LVL 44

Expert Comment

by:bruintje
ID: 2562226
OK i bought this one, because it's worth it, and now i got the code myself :O)

Private Declare Function OpenProcess Lib "kernel32" _
    (ByVal dwDesiredAccess As Long, _
    ByVal bInheritHandle As Long, _
    ByVal dwProcessId As Long) As Long


Private Declare Function GetExitCodeProcess Lib "kernel32" _
    (ByVal hProcess As Long, lpExitCode As Long) As Long


Private Declare Function CloseHandle Lib "kernel32" _
    (ByVal hObject As Long) As Long
    Public Const PROCESS_QUERY_INFORMATION = &H400

 

Sub Command1_Click()

    RunShell "c:\windows\notepad.exe"
End Sub

Private Sub RunShell (cmdline$)

    Dim hProcess As Long
    Dim ProcessId As Long
    Dim exitCode As Long
    ProcessId& = Shell(cmdline$, 1)
    hProcess& = OpenProcess(PROCESS_QUERY_INFORMATION, False, ProcessId&)


    Do
        Call GetExitCodeProcess(hProcess&, exitCode&)


        DoEvents
        Loop While exitCode& > 0

        MsgBox "The Shelled process " & cmdline$ & " has ended."
    End Sub

 

seems there are more ways of doing it

http://www.thescarms.com/vbasic/Wait.htm

I just took that code and modified it to get it running in Excel

Option Explicit

Public Const SYNCHRONIZE = &H100000
Public Const INFINITE = &HFFFF  ' Wait forever
Public Const WAIT_OBJECT_0 = 0   ' The state of the specified object is signaled
Public Const WAIT_TIMEOUT = &H102  ' The time-out interval elapsed and the object’s state is nonsignaled.

Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, _
            ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, _
            ByVal dwMilliseconds As Long) As Long
Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long


Sub WaitingTillDone()

Dim lPid As Long
Dim lHnd As Long
Dim lRet As Long

lPid = Shell("c:\windows\calc.exe", vbNormalFocus)
If lPid <> 0 Then
        'Get a handle to the shelled process.
        lHnd = OpenProcess(SYNCHRONIZE, 0, lPid)
        'If successful, wait for the application to end and close the handle.
        If lHnd <> 0 Then
                lRet = WaitForSingleObject(lHnd, INFINITE)
                CloseHandle (lHnd)
        End If
        MsgBox "Just terminated.", vbInformation, "Shelled Application"
End If

End Sub

and it worked wonderfully!, got a new trick on my sleeve :O)

Now you only have exchange the calc.exe thing for your process

HTH:O)Bruintje


0
 
LVL 8

Expert Comment

by:stochastic
ID: 2562757
bruintje,

I was thinking of answering this one (have done something similar before) but then got your answer which looks very good! I will try that out. The good thing about this EE is that I learn even with a casual walk-around!

- stochastic
0
 
LVL 44

Expert Comment

by:bruintje
ID: 2562767
thanks for that!..stochastic

the funny thing is that after a period out of the field of computers, it all comes together a bit easier....

a line of code is now a step to a solution and not a line of code, seems very important... :O)

becoming more versatile in other things like VB/MSSQL(and all the derivates) after my start in Delphi/Oracle gives a broader scape to search for solutions....
0
 
LVL 4

Expert Comment

by:Noggy
ID: 2562847
Hmmm, that looks quite a nice one, Bruintje. Let's see if I can steal this one from you :-) .....

toffee - Here's a home-grown version that I use in my apps. I know it works ('cos I use it :-) ):

The first procedure below is my equivalent of your procedure where you are going to use the Shell app. The functions below that are called from that procedure.

NOTE: The line blnWait = AppStillRunning("OS2") will need to be amended so that the "OS2" is replaced by the Window caption that your Shelled app produces. The best way to find this is to run the app on its own and note the text in the Window title.

You may also notice that in the AppStillRunning function, there is a 5 second delay to ensure that the o/s has launched the app properly in its shell. After all, this part of the process is invariably slow.


'******************************************************************
'GENERAL DECLARATIONS
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetWindow Lib "user32" (ByVal Hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal Hwnd As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal Hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Const GW_CHILD = 5
Private Const GW_HWNDNEXT = 2
Private Const hNull As Long = 0
'******************************************************************


Public Sub YourProc()
   
    Dim dRetVal As Double 'The value returned from the shell statement
    Dim blnWait As Boolean 'Flag used to indicate that the Shell is still running
    Dim sCommand As String 'The DOS command that will be executed - includes all the variables
       
        On Error GoTo YourProc_Error
        '**********************
        'Put your pre-run code here including a line with:
        'sCommand = "MyApp.Exe arg1, arg2, arg3" etc.
        '**********************
       
        'Run your application
        DoEvents
        blnWait = True
       
        On Error GoTo Shell_Error
        dRetVal = Shell(sCommand, vbMinimizedNoFocus)
        On Error GoTo YourProc_Error
             
        'Wait until the app has finished running
        Application.StatusBar = "Waiting for application to finish processing...Please Wait..."
        Do While blnWait = True
            'The parameter passed to the AppStillRunning function is the name of the title bar on the window in which the executable runs
            '(NB. BE CAREFUL RUN FIRST TO SEE TITLEBAR THEN SET PARAMETER)
            blnWait = AppStillRunning("OS2")
        Loop
       
        DoEvents
       
        '**********************
        'Put your code here
        '**********************
       
YourProc_Exit:
    On Error Resume Next
    '**********************
    'Put your normal procedure exit code lines here
    '**********************
    Exit Sub

Shell_Error:
    Select Case Err.Number
    Case 53
        MsgBox "The Shell command could not be invoked" & vbCr & _
            "because the .EXE file does not exist in the specified location." & vbCr & _
            "Please ensure that this file is at that location.", _
            vbOKOnly + vbExclamation, _
            ".EXE Not Found"
    Case Else
        MsgBox "The Shell command could not be invoked." & vbCr & _
            "Please contact your local support for support.", _
            vbOKOnly + vbExclamation, _
            "" & Err.Source & ": " & Err.Number & "-" & Error(Err.Number)
    End Select
    Resume YourProc_Exit
   
YourProc_Error:
    '**********************
    'Put your normal error handler code lines here
    '**********************
    Resume YourProc_Exit

End Sub

'*******************************************************************
'What:          ******Acquired directly from existing code in my Best Practices database******
'                   Determines whether the Shelled App is still being executed by the Operating System.
'Called by:    -
'Passed:       byRef sAppName as string - the Application name of the Shelled App to monitor
'Calls:           -
'Returns:       Boolean - whether the App is still running
'Created by:   Robin 'Nog' Davis
'When:           07/08/1998
'Revised by:   '
'When:          '
'*******************************************************************
Private Function AppStillRunning(sAppName As String) As Boolean

    Dim Hwnd As Long
    Dim iRetVal As Integer
    Dim sTitle As String
    Dim dTimeStamp As Double
    Dim dCurrentStamp As Double
   
       
    On Error GoTo AppStillRunningErr
   
    ' used to delay the lookup of the application by 5 seconds
    dTimeStamp = Now()
    dCurrentStamp = Now()
   
    Do Until Second(dCurrentStamp - dTimeStamp) > 5
        dCurrentStamp = Now()
    Loop
    AppStillRunning = False
       
'   Form is top-level, so start with first sibling
'   calls to API's to get window handles
    Hwnd = GetDesktopWindow()
    Hwnd = GetWindow(Hwnd, GW_CHILD)

    Do While Hwnd <> hNull
        'strip off char(13)
        sTitle = VBGetWindowTextLine(Hwnd)
        ' Display only titled, visible, unowned windows
        If sTitle <> "" Then
            ' look as sTitle for Application Name or Window name (parameter supplied via sAppName)
            If InStr(sTitle, sAppName) > 0 Then
                AppStillRunning = True
                Exit Function
            End If
        End If
        ' get next window id.
        Hwnd = GetWindow(Hwnd, GW_HWNDNEXT)
    Loop
   
AppStillRunningOut:
    Exit Function

AppStillRunningErr:
    AppStillRunning = True
    Resume AppStillRunningOut
           
End Function

'*******************************************************************
'What:          ******Acquired directly from existing code in tmy Best Practices database******
'                   '
'Called by:    -
'Passed:       Hwnd as Variant - ???
'Calls:           -
'Returns:       String - The Title of the Window
'Created by:   Robin 'Nog' Davis
'When:           07/08/1998
'Revised by:   '
'When:          '
'*******************************************************************
Private Function VBGetWindowText(ByVal Hwnd) As String

    Dim iCharLength As Integer
    Dim sTitleText As String

    iCharLength = GetWindowTextLength(Hwnd)

    If iCharLength <> 0 Then
        sTitleText = String$(iCharLength, 0)
        iCharLength = GetWindowText(Hwnd, sTitleText, iCharLength + 1)
        VBGetWindowText = sTitleText
    End If

End Function

Private Function VBGetWindowTextLine(ByVal Hwnd) As String

    Dim sTitle As String
    Dim cTitle As Integer

    sTitle = VBGetWindowText(Hwnd)
    ' Chop off end of multiline captions
    cTitle = InStr(sTitle, vbCr)

    VBGetWindowTextLine = IIf(cTitle, Left$(sTitle, cTitle), sTitle)

End Function


'******************************************************************

If you need any more help, feel free to give me a yell. Hopefully, you might prefer my solution over Bruintje's :-). If not, you will still have two solutions for the price of one.
0
 
LVL 44

Expert Comment

by:bruintje
ID: 2562873
hmmmm.......nicely formatted Noggy, :O)(bruintje laughing)

your code is now being thrown in my own best practices database along with already was presented above....

good PAQ this is going to be...
0
 
LVL 4

Expert Comment

by:Noggy
ID: 2562889
bruintje - What? You don't like my formatting? :-) I'm putting your code in my Best Practices database too. Mind you, I would have also thought that you would have something like this anyway. But, you may be like me and hate to use to Shell - except when it's absolutely, absolutely.....absolutely necessary.

Indeed, a good PAQ it will be. Thankfully, you and I won't have to pay for it :-)

Thinking along these lines though, do you think EE would like to start a Best Practices database (like PlanetSourceCode etc.)? That way, Experts can post nice code onto EE and we could then get points for the quantity of accesses we get, depending on the complexity and neatness of the code. The point system could be a bit subjective though.
0
 
LVL 44

Expert Comment

by:bruintje
ID: 2562901
talking about rewarding, should be like a shareware concept????

just passed by the CNET help site, and saw something like expertcity.com....

don't know if i've to apply for an American working permit to get into that, but it seems quite interesting...

btw if i couldn't do it for them, why not start one of our own :O)

the net is all about replication, till the weaker ones get swallowed by the big fish and free isn't their kind of trade :O)
0
What Is Threat Intelligence?

Threat intelligence is often discussed, but rarely understood. Starting with a precise definition, along with clear business goals, is essential.

 

Author Comment

by:toffee
ID: 2563365
I'll never cease to be amazed at the quality of the experts on E-E. I now actually have three working methods.

The awarding of points will be a hard decision.

Before I do I've a couple of questions/comments to ask of Noggy.

When I run your code it leaves the waiting message in the status bar. Have I done something wrong or is that an error? Don't mis-understand me I'm certainly not criticizing suct a great piece of code.

The other question is I happened to change the line
dRetVal = Shell(sCommand, vbMinimizedNoFocus)
to vbNormalFocus so I could see the ftp taking place. When I did so the code appeared to run a lot quicker than before. Why would that be?
0
 
LVL 8

Expert Comment

by:stochastic
ID: 2563751
Noggy said:
>Indeed, a good PAQ it will be. Thankfully, you and I won't have to pay for it :-)

you bet (a good PAQ)! And you know what, even _I_ don't have to pay for this - I am going to save this whole page before toffee accepts the answer and locks it (so I save 20 points for buying it later, you see?)

sorry for adding comments but not value. hope you don't mind, toffee. sometime, someday, maybe I will sneak in and give you an answer before the bruintje's and noggy's get a chance :-)


Further, Noggy said:
> do you think EE would like to start a Best Practices database (like PlanetSourceCode etc.)? That way, Experts can post nice code onto EE and we could then get points for the quantity of accesses we get, depending on the complexity and neatness of the code.

Just what I was thinking too. Have you folks had a look at expertcity.com? EE could take a cue or two from them too?

- stochastic
0
 
LVL 17

Expert Comment

by:calacuccia
ID: 2563904
Hi people,

now I won't have to pay neither. But as I did not dare step in before getting a decent contribution, Stochastic just provided me the occasion.

You don't have to save this page, Stochastic, as soon as you've made a comment in a thread, you can access it freely after the question is closed. So everyone with comments in this question have access.

Sneaking' Calacuccia
0
 
LVL 22

Accepted Solution

by:
ture earned 200 total points
ID: 2564090
toffee,

I'm too lazy to read through all the previously posted code. Here is an alternate approach that may apply to your problem...

If your FTP is returning a file with a known file name and file location, you could use this little loop to check if it has finished downloading.

Sub LoopUntilFileIsAvailable()
  Dim f As Integer
  f = FreeFile
  On Error Resume Next
  Do
    Open "c:\test\test.txt" For Input Lock Read As f
  Loop Until FreeFile <> f
  On Error GoTo 0
  Close f
End Sub

Ture Magnusson
Karlstad, Sweden
0
 
LVL 4

Expert Comment

by:Noggy
ID: 2564742
toffee - Oops, I forgot to include the line:
Application.StatusBar = False in:

YourProc_Exit:
     On Error Resume Next
     '**********************
     'Put your normal procedure exit code lines here
     '**********************
     Application.StatusBar = False '<<<<<<Add it here
     Exit Sub

Don't worry, I don't take it as criticism - just laziness and slack on my part :-) . It sounds like you've never used the StatusBar then. It is a useful property to use. I use it for each major step in a procedure (including loops). It's much easier to debug and help users with difficulties at the same time.

For your second q, yeah, it should run a bit quicker (depending on the OS) as NormalFocus will mean that your OS will assign a larger CPU time slice to that app. Minimized apps get much less.

Bruintje & Stochastic - ExpertCity.Com? Hmm, I'll have to have a look at that tonight (not enough time at work - boss gets angry). If it's crap, we could set up our own - hopefully, as bruinje implied, we may get swallowed by a bigger fish.....and get paid off HUGE amounts too.

Bruintje - I'd also need a US visa too. I think it should be easy to get - even with Y2K under the bridge, they're still gagging for techies.

Stochastic & Calacuccia - That's the benefit of looking at each of the questions that are posted. One little comment and you can view whenever you want - as long as you get in there before the likes of bruintje, ture, cal et al get the thing answered :-) .

Ture - Nice, alternative, concise solution!! It is a very specific solution to the question (but probably the best in this case :-) ). However, as you know, it wouldn't be the best in all Shell cases as, invariably, you are not always waiting for something to pop out at the end.
0
 

Author Comment

by:toffee
ID: 2566441
I think everyone has and will benefit from this question. I know I certainly have.
I'd like to thank everyone who has contributed. As you must have guessed I am still very green about the gills with vb and I've really enjoyed reading and learning from your suggestions. I think I've learned something from everyone's code.

All the code posted actually solved the problem and made my decision even harder.
However, there does have to be a decision made. Bearing in mind my knowledge is still very limited, it has to go to Ture because he provided a very simple answer to the question (which even I could understand). The simple ones aren't always the best but to this specific question it is. To be honest I really should have thought of that solution myself, but then that's why I use EE.

Having said that, and having read the code from noggy and bruintje I will be having another look at the way I'm trying to achieve my objective. With their permission I would like to use the code they posted (or parts of it) in the future. And I look forward to giving them lots of points in the future.

Many thanks again.
0
 

Author Comment

by:toffee
ID: 2566448
Excellent Ture.
I wish everything in life was as simple.
0
 
LVL 22

Expert Comment

by:ture
ID: 2567877
toffee,

Thanks for the points. I am glad that my suggested solution suited your needs.

/Ture
0
 
LVL 4

Expert Comment

by:Noggy
ID: 2568028
toffee - No problem. The code is there for you to use - there would be no way that we could stop you using it anyway :-).

Ture - stop laughing your socks off :-)
0
 
LVL 22

Expert Comment

by:ture
ID: 2568060
Noggy,

It's kind of hard but I'll try...
:oD    8-)   :oO    :oD    :-D

/Ture
0

Featured Post

Why You Should Analyze Threat Actor TTPs

After years of analyzing threat actor behavior, it’s become clear that at any given time there are specific tactics, techniques, and procedures (TTPs) that are particularly prevalent. By analyzing and understanding these TTPs, you can dramatically enhance your security program.

Join & Write a Comment

Suggested Solutions

How many times recently have you prepared a presentation or emailed a document to a client and you have found that they have older versions of MS Office and they can not open the file you have prepared.  Although most visitors to this site are exper…
No matter the version of Windows you are using, you may have some problems with Windows Search running too slow or possibly not running at all. Before jumping into how you can solve this issue, just know there are many other viable alternative deskt…
The viewer will learn how to make their project stand out over others by learning how to change colors and shapes, add spaces, change directions, and add bullets to their charts.
The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …

708 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

16 Experts available now in Live!

Get 1:1 Help Now