Run another software program programmatically?

[Hap]

The USGS has a .jar program used to provide earthquake hazard data giving lat and long coordinates. The program also has an option to import and export an .xls batch file.

Is it "possible" to programmatically open, run, send a batch file, return the batch file, and close the program all in VBA?

Thank you

 

[Hap]

The reason is you can input lat and long or zip code and it provides you with seismic factors. These factors are used in the building code to generate seismic loads for a building. I have a workbook that will automatically generate these loads based on basic structure information except that you open the other program, input lat and long, export or print the values, and then turn around and put them back into the workbook. If I can get the program to do this automatically then it removes a step and hences speeds up the process. That's my point.

The USGS site provides all the background files to generate these data points and the coding to locate them based on lat and long or zip but that is a lot of coding to get the same result as the program that is already put together. I'm trying to simplify as much as possible.

Thanks for any help

 

[Ruddles]

Sorry, I didn't explain myself very well. I wasn't asking why you'd want to call an external program to do your calculations - that's a common thing to do - what I meant was, why were you thinking of using a MsgBox-driven wait when ShellWait would do the job without any user intervention? But either way will work just fine so go with the one you feel more comfortable with.

As regards how to pass parameters to the program, that depends on whether it accepts them at all and then how it expects them to be formatted. If you can get the program to run with parameters from a command line prompt, the Windows Start > Run... box or a batch or script file, then we'll be able to translate that command into the equivalent Shell command.

Of course then you'll need to work out how to import the results of the program back into Excel, but I'm sure this forum will be able to sugegst solutions if you get stuck on that part of the process.

 

[Hap]

I'm following you now. Somehow that made sense to me yesterday. However, if I can open the program, get it to process the batch file as desired and close then there is no need for a user driven wait. I may contact USGS about it the rest of it. Chances are they will be open to helping me out. The exported batch file is rather simple to get values from and I have already worked out the functions for using their data.

Thank you

 

[Ruddles]

Well come back here if you need to discuss further.

 

[Hap]

OK. I'm back to this same problem. I actually managed to get the USGS program to work through VBA using sendKeys with the code below. Problem is, it wouldn't work without putting in the delay for each SendKey. Not only that, it is very sensitive to the timing which is based on how fast the computer its being run on opens and executes the USGS program. The program is downloadable freeware at

http://earthquake.usgs.gov/hazards/designmaps/javacalc.php

The VBA creates two batch files for the USGS program to work with; an input and an output file. If anyone can give me some ideas how to make this a little more solid and work without the delays I would greatly appreciate it. Thank you!!!



Sub getSeismic()

Dim siteClass As String
Dim iBatch As String
Dim oBatch As String
Dim latC As Double
Dim lonC As Double
Dim Ss As Double
Dim S1 As Double

Dim Ret As Long

Dim wbHi As Workbook
Dim wsSi As Worksheet
Dim wbHo As Workbook
Dim wsSo As Worksheet


'iBatch = "C:\Documents and Settings\eng48\My Documents\CTS Program\hazBatchi.xls"
'oBatch = "C:\Documents and Settings\eng48\My Documents\CTS Program\hazBatcho.xls"

With UserFormJobInfo
latC = .TextBox18.Value
lonC = .TextBox19.Value
siteClass = .ComboBox5.Value
End With

Application.Workbooks.Add
Set wbHi = Application.ActiveWorkbook
With wbHi
Set wsSi = wbHi.Sheets("Sheet1")
wsSi.Cells(2, 1).Value = latC
wsSi.Cells(2, 2).Value = lonC
wsSi.Cells(2, 3).Value = siteClass
.Save
iBatch = .Path
iBatch = iBatch & "\" & .Name
'MsgBox "Full Path name is " & iBatch
.Close
End With

Application.Workbooks.Add
Set wbHo = Application.ActiveWorkbook
With wbHo
.Save
oBatch = .Path & "\" & .Name
.Close
End With
Ret = fnShellOperation("M:\earthquake program\NSHMP_HazardApp.jar", "Open", SW_MAXIMIZE)
Application.Wait (Now + TimeValue("0:00:08"))
'AppActivate Ret, True
'MsgBox "Full Path Name is " & oBatch
SendKeys "{TAB}", True
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys "{ENTER}", True
Application.Wait (Now + TimeValue("0:00:02"))
SendKeys "{DOWN}", True
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys "{DOWN}", True
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys "{TAB}", True
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys "{TAB}", True
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys "{TAB}", True
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys "{DOWN}", True
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys "{TAB}", True
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys "{RIGHT}", True
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys "{RIGHT}", True
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys "{TAB}", True
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys iBatch, True
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys "{TAB}", True
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys "{TAB}", True
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys oBatch, True
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys "{TAB}", True
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys "{TAB}", True
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys "~", True
Application.Wait (Now + TimeValue("0:00:03"))
SendKeys "%{F4}", True
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys "~", True

Application.Workbooks.Open (oBatch)
Set wbHo = Application.ActiveWorkbook
Set wsSo = wbHo.Worksheets("Ss & S1 Values")
Ss = wsSo.Cells(ListRowN("Latitude (Degrees)", wsSo) + 1, 4)
S1 = wsSo.Cells(ListRowN("Latitude (Degrees)", wsSo) + 1, 5)
wbHo.Close

With UserFormJobInfo
.TextBox20.Value = Ss
.TextBox21.Value = S1
End With



End Sub

 

[Hap]

I realize this is very brute-force so if anyone has any suggestions I'm open.

thanks

 

[Ruddles]

I've just written some code which will wait for a program to load and return its process id. You can tell it to wait for ever (not wise - the program may fail to load!), or you can tell it to time out after a set time and return zero.

If you'd like to try it out, drop this code into a new general code module:-

Option Explicit
Private Const TH32CS_SNAPPROCESS As Long = 2&
Private Const MAX_PATH As Integer = 260
Private Type PROCESSENTRY32
  dwSize As Long
  cntUsage As Long
  th32ProcessID As Long
  th32DefaultHeapID As Long
  th32ModuleID As Long
  cntThreads As Long
  th32ParentProcessID As Long
  pcPriClassBase As Long
  dwFlags As Long
  szexeFile As String * MAX_PATH
End Type
Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal lFlags _
    As Long, ByVal lProcessID As Long) As Long
Private Declare Function Process32First Lib "kernel32" (ByVal hSnapshot As Long, _
    uProcess As PROCESSENTRY32) As Long
Private Declare Function Process32Next Lib "kernel32" (ByVal hSnapshot As Long, _
    uProcess As PROCESSENTRY32) As Long
Private Declare Sub CloseHandle Lib "kernel32" (ByVal hPass As Long)
 
Public Function WaitForProcess(ByVal aProcessName As String, Optional aMaxWait As Date) As Long
 
  Dim hSnapshot As Long
  Dim procEntry As PROCESSENTRY32
  Dim result As Long
  Dim pid As Variant
  Dim pproc As Variant
  Dim iPtr As Integer
  Dim dMaxDate As Date
  Dim dStartDate As Date
  
  WaitForProcess = 0
  
  If IsMissing(aMaxWait) Then aMaxWait = 0
  dStartDate = Now()
  dMaxDate = dStartDate + aMaxWait
  
  Do Until (aMaxWait = 0 And WaitForProcess > 0) Or (aMaxWait > 0 And (Now() > dMaxDate Or WaitForProcess > 0))
    ' take a snapshot of all active processes
    hSnapshot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
    ' raise error if fails (for example under WinNT)
    If hSnapshot = -1 Then Err.Raise 999, , "Unable to get process snapshot"
    ' prepare the receiving buffer
    procEntry.dwSize = Len(procEntry)
    result = Process32First(hSnapshot, procEntry)
    Do While result
      pproc = Left$(procEntry.szexeFile, InStr(procEntry.szexeFile & vbNullChar, vbNullChar) - 1)
      pid = procEntry.th32ParentProcessID
      If LCase(pproc) = LCase(aProcessName) Then
        ' looks like the process we're interested in is running
        WaitForProcess = procEntry.th32ProcessID
        Exit Do
      End If
      result = Process32Next(hSnapshot, procEntry)
    Loop
    ' close the snapshot
    CloseHandle hSnapshot
    Loop
      
End Function

Sample code for testing it:-

Option Explicit
 
Public Sub TestFrame1()
 
  Const sProgram As String = "msaccess.exe"
  Dim sPID As Long
  
  ' wait for ever for program to load (unwise!)
  sPID = WaitForProcess(sProgram)
  MsgBox "PID for " & sProgram & " is " & WaitForProcess(sProgram)
  
End Sub
 
Public Sub TestFrame2()
 
  Const sProgram As String = "msaccess.exe"
  Dim dWait As Date: dWait = TimeValue("00:01:00")
  Dim sPID As Long
  
  ' wait for thirty seconds for program to load
  sPID = WaitForProcess(sProgram, dWait)
  If sPID = 0 Then
    MsgBox "Timed out after " & Format(dWait, "hh:nn:ss") & " - " & sProgram & " not loaded!"
  Else
    MsgBox "PID for " & sProgram & " is " & WaitForProcess(sProgram)
  End If
  
End Sub

To integrate into your code, try replacing this:-

Ret = fnShellOperation("M:\earthquake program\NSHMP_HazardApp.jar", "Open", SW_MAXIMIZE)
Application.Wait (Now + TimeValue("0:00:08"))

with this:-

Ret = fnShellOperation("M:\earthquake program\NSHMP_HazardApp.jar", "Open", SW_MAXIMIZE)
WaitForProcess([COLOR=red][I][B]imagename[/B][/I][/COLOR], TimeValue("0:01:00"))

You have to know what your program's 'image name' is: get this from Task Manager.

I don't know if that's any use to you...

 

[Hap]

This is awesome. I haven't figured out if it works yet but I wanted to let you know I really appreciate this response.

Thank you!!!

 

[Hap]

Not working. What exactly is the process returning that indicates it is ready for the next user input? Clearly the VBA code is jumping the gun because the module is done executing before the java program is ready for the first user input.

Thanks for the help

 

[Ruddles]

When you run WaitForProcess, it checks to see if there's a program running with the image name you passed to it when you called it. If there isn't it will loop - either for ever or for the time you passed to it - and jumps out of the loop either when it sees the process appear (in which case it returns the process id) or when the time has elapsed (in which case it returns a zero).

Check it works as follows:-

• Make sure MS Word isn't running
• In the VBA Immediate window (Ctrl-G), type msgbox waitforprocess("winword.exe")
• Wait a moment... no message box appears
• Start Word
• Message box reports process id
• Back to the Immediate window, type msgbox waitforprocess("winword.exe") again
• Message box should appear immediately
• Close Word
• Back to the Immediate window (Ctrl-G), type msgbox waitforprocess("winword.exe",timevalue("00:01:00"))
• After a minute it should timeout and report a return value of zero

Perhaps WaitForProcess is detecting the appearance of your Java program but then exiting before the Java program is ready, as you say. If that's the case, I'm not sure what to do. If your eight-second wait was already doing the job reliably, then it's a lot simpler than my program.

On the plus side, I've now learned how to manipulate processes in memory and I've already thought of a use for my code!