How to pass parameters between vba and vb - vb.net

I'm making a tool, where I need to start a programm (which I want to code with VB) by using VBA in an Excle file. When I close that programm, it should give back a parameter to the VBA script.
I started just now with the VBA script and didn't code anything of the VB programm yet. But I need to know, what to write in the VBA script and wheter this is possible.
So it should work like this:
I'm in the Excel file and I press a button
The programm is starting (also getting a parameter from the Excel file, this is not that important yet)
In that programm I configurate some stuff
Closing that Programm it should give back a ID of that configuration
I'm getting back to the Excel file with this ID
Is this possible? And what do I need to write in the VBA script and in the Programm to give back a parameter?
I hope you understand what I mean and you can help me

You could set your VB .exe to return an Exit code. Just make sure the id isn't 0 (means ran successfully) or 259 (calling process will think process is still running). The VBA below runs an .exe, waits for it to close, then returns the exit code.
Option Explicit
' Api declarations
Private Declare Function GetExitCodeProcess Lib "Kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
Private Declare Function OpenProcess Lib "Kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
Public Function RunProgram(ByVal strFilename As String) As Long
'# PURPOSE: Run a program, wait until closed, and return the exit code
Dim TaskID As Long
Dim hProc As Long
Dim lExitCode As Long
Const ACCESS_TYPE = &H400
Const STILL_ACTIVE = &H103
' Open the program
TaskID = Shell(strFilename, 1)
hProc = OpenProcess(ACCESS_TYPE, False, TaskID)
If Err <> 0 Then
Debug.Print "Cannot start " & strFilename, vbCritical, "Error"
Exit Function
End If
' Wait until program is closed
Do
GetExitCodeProcess hProc, lExitCode
DoEvents
Loop While lExitCode = STILL_ACTIVE
' Return the program's exit code
RunProgram = lExitCode
End Function

Related

Detect Other Instance of Open Workbooks

I'm trying to have the user select an instance or open Workbook of Excel. The idea is to have a window that will display all open Instances of Excel and then display the Workbooks within these instances. I've done some self research and what I've found below...
Public Declare Function GetDesktopWindow Lib "user32" () As Long
Public Declare Function FindWindowEx Lib "user32" Alias _
"FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Function ExcelInstances() As Long
Dim hWndDesk As Long
Dim hWndXL As Long
'Get a handle to the desktop
hWndDesk = GetDesktopWindow
Do
'Get the next Excel window
hWndXL = FindWindowEx(GetDesktopWindow, hWndXL, _
"XLMAIN", vbNullString)
'If we got one, increment the count
If hWndXL > 0 Then
ExcelInstances = ExcelInstances + 1
End If
'Loop until we've found them all
Loop Until hWndXL = 0
End Function
Problem:
When I ran the code, I am getting the error message:
Compile Error:
Only comments may appear after End Sub, End Function or End Property
It's highlighting the first line in the code, and I believe it has something to do with the "user32" string?
Question:
This code will only give me a COUNT of how many instances of Excel are currently open. Is there any way to return the names of the instances and then another sub routine that would return the Workbooks within the instances as well? I've seen a solution making use of VB.Net; however I'd like to avoid this so that I can try to keep everything consolidated into a single Excel Spreadsheet (if possible).

Wait until process is finished running

I'm launching a program from a VBA macro and I need to wait for it to finish running before I can go and post-process the resulting data.
So far, I've been satisfied with the following as the running time was pretty consistent (about 2sec.) :
While FileLen(outputFilename) < 9000 And (Timer - Chrono) < 10
Wend
Indeed I've observed that all the result data is written in one go and before that, the output size doesn't exceed 9Ko.
Anyway, for some reason, the program isn't consistent anymore so I looked a bit more into a clean solution to wait for the shell process to stop.
I found ideas about WaitForSingleObject and the module ShellAndWait which I found here. This post is what helped me with finding some functions.
My problem now is that the macro keeps running while the Shell is still open. From what I understand, WaitForSingleObject returns 0, which should mean the Shell is closed (or finished running), but it's not.
More specifically, in ShellAndWait,
WaitRes = WaitForSingleObject(ProcHandle, DEFAULT_POLL_INTERVAL)
raises 0.
I tried to extract the significant part of the code by adapting it a bit :
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Const SYNCHRONIZE = &H100000
Public Const INFINITE = &HFFFF
Public Const PROCESS_ALL_ACCESS = &H1F0FFF
Sub launch()
analysisPath = "Path to the files to feed to the programm"
ShellCommand = "Program to run + arguments"
ChDrive ThisWorkbook.Path
ChDir analysisPath
fileID = Shell(ShellCommand, vbNormalFocus)
ProcHandle = OpenProcess(SYNCHRONIZE, False, fileID)
If ProcHandle<>0 Then
WaitRes = WaitForSingleObject(ProcHandle, INFINITE)
Else
MsgBox "Failed running Nastran"
End If
fileID = CloseHandle(ProcHandle)
End Sub
And WaitResstill raises 0.
Am I using WaitForSingleObject wrong and if so, could you point me in the right direction ?
edit : It also doesn't work with the solution accepted in this post (meaning the shell runs but doesn't stop the macro to keep going). Could it be due to the specific program I'm running which would behave strangely ?
So, I kept searching and I found a bit of code that worked.
I actually found it here.

Which script is better for automation of PTC Integrity application

I want to create one script that will open the windows application and use that application to perform some task. I have listed out the activity that I want to automate below:
Application is PTC integrity. It is linked with database server that has lot of files in it which have unique ID. So I need to use ID to open the document and export it.
Steps:
Open the application.
Open the document using ID.
Export the document to some specific format.
I want to know which scripting to be used to automate this process, i.e., I give array of IDs , the script will open the application and then open the document using IDs and export them till all the IDs are exported. Using Excel VBA can it be done.
Yes you can do this in VBA.
Your VBA can call a batch file via the Shell command that uses PTC Integrity Command Line Interface.
To export a document you can use the 'im exportissues' CLI command.
To call a batch file synchronously you can use the ShellandWait function below or see related StackOverflow question.
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess _
As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle _
As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Sub ShellAndWait(ByVal program_name As String, _
Optional ByVal window_style As VbAppWinStyle = vbNormalFocus, _
Optional ByVal max_wait_seconds As Long = 0)
'http://www.vbforums.com/showthread.php?t=505172
' Example:
' Private Sub Form_Load()
' Me.Show
' ShellAndWait "Notepad.exe", , 3
' Me.Caption = "done"
' End Sub
Dim lngProcessId As Long
Dim lngProcessHandle As Long
Dim datStartTime As Date
Const WAIT_TIMEOUT = &H102
Const SYNCHRONIZE As Long = &H100000
Const INFINITE As Long = &HFFFFFFFF
' Start the program.
On Error GoTo ShellError
lngProcessId = Shell(program_name, window_style)
On Error GoTo 0
DoEvents
' Wait for the program to finish.
' Get the process handle.
lngProcessHandle = OpenProcess(SYNCHRONIZE, 0, lngProcessId)
If lngProcessHandle <> 0 Then
datStartTime = Now
Do
If WaitForSingleObject(lngProcessHandle, 250) <> WAIT_TIMEOUT Then
Exit Do
End If
DoEvents
If max_wait_seconds > 0 Then
If DateDiff("s", datStartTime, Now) > max_wait_seconds Then Exit Do
End If
Loop
CloseHandle lngProcessHandle
End If
Exit Sub
ShellError:
End Sub
I Prefer Python to automate multiple processes in PTC.You can use CLI commands for all your operations.Run those CLI commands from Python using subprocess method. Get your output in your preferable format.

VB.NET Wait a DOS shell program to terminate before continuing- doesn't work

I am building a Windows Forms Application on VS2010, through which I need to execute a 3d party DOS shell program (OpenSees.exe), open a source file in it and perform an analysis. After this, some output files are created which I need to read again in my VB.NET app.
The thing is that the analysis in OpenSees may take a long time, so the VB code has to wait for it before carrying on.
For this, I have tried both "ShellandWait" sub along with "WaitForSingleObject" function and "process class" option, but neither of then works.
My DOS shell program initializes, but it closes almost immediately, not letting the analysis to complete and the required output to be created.
Here are the code snippets I used:
1st try: ShellandWait
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess _
As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle _
As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Sub ShellAndWait(ByVal program_name As String, _
Optional ByVal window_style As AppWinStyle = vbNormalFocus, _
Optional ByVal max_wait_seconds As Long = 0)
Dim lngProcessId As Long
Dim lngProcessHandle As Long
Dim datStartTime As Date
Const WAIT_TIMEOUT = &H102
Const SYNCHRONIZE As Long = &H100000
Const INFINITE As Long = &HFFFFFFFF
' Start the program.
On Error GoTo ShellError
lngProcessId = Shell(program_name, window_style)
On Error GoTo 0
Threading.Thread.Sleep(1500)
'System.Windows.Forms.Application.DoEvents()
SendKeys.Send("source " & filename & ".tcl")
SendKeys.Send("{ENTER}")
' Wait for the program to finish.
' Get the process handle.
lngProcessHandle = OpenProcess(SYNCHRONIZE, 0, lngProcessId)
If lngProcessHandle <> 0 Then
datStartTime = Now
Do
If WaitForSingleObject(lngProcessHandle, 250) <> WAIT_TIMEOUT Then
Exit Do
End If
'DoEvents()
If max_wait_seconds > 0 Then
If DateDiff("s", datStartTime, Now) > max_wait_seconds Then Exit Do
End If
Loop
CloseHandle(lngProcessHandle)
End If
Exit Sub
ShellError:
End Sub
...
ShellAndWait("OpenSees.exe", , 3)
2nd try: ProcessStart
Dim p As New Process
Dim psi As New ProcessStartInfo("OpenSees.exe", "source " & filename & ".tcl")
p.StartInfo = psi
p.Start()
p.WaitForExit()
I don't understand why this isn't working. Any help would be much appreciated!
Try this:
Shell("OpenSees.exe <arguments>",, True)

VBA to Prevent Keyboard Input While a Package Object (XML) is Read into ADODB Stream?

I am developing an application which opens and reads an XML document previously embedded in a PowerPoint presentation, or a Word document. In order to read this object (xmlFile as Object) I have to do:
xmlFile.OLEFormat.DoVerb 1
This opens the package object, and I have another subroutine that gets the open instance of Notepad.exe, and reads its contents in to ADODB stream.
An example of this procedure is available on Google Docs:
XML_Test.pptm.
During this process there is a few seconds window where the Notepad.exe gains focus, and an inadvertent keystroke may cause undesired results or error reading the XML data.
I am looking for one of two things:
Either a method to prevent the user from inadvertently inputting (via keyboard/mouse/etc) while this operation is being performed. Preferably something that does not take control of the user's machine like MouseKeyboardTest subroutine, below. Or,
A better method of extracting the XML data into a string variable.
For #1: this is the function that I found, which I am leery of using. I am wary of taking this sort of control of the users system. ##Are there any other methods that I might use?##
Private Declare Function BlockInput Lib "USER32.dll" (ByVal fBlockIt As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub MouseKeyboardTest() 'both keyboard and mouse blocked
BlockInput True ' Turns off Keyboard and Mouse
' Routine goes here
Sleep 5000 ' Optional coding
BlockInput False ' Turns on Keyboard and Mouse
End Sub
For #2: Some background, but the issue seems to be the inability to extract the embedded object reliably using any method other than DoVerb 1. Since I am dealing with an unsaved document in an application (Notepad) that is immune to my VBA skillz, this seems to be the only way to do this. Full background on that, here:
Extracting an OLEObject (XML Document) from PowerPoint VBA
As you correctly guessed in the comment above that taking the focus away from notepad will solve your problem. The below code does exactly that.
LOGIC:
A. Loop through the shape and get it's name. In your scenario it would be something like Chart Meta XML_fbc9775a-19ea-.txt
B. Use APIs like FindWindow, GetWindowTextLength, GetWindow etc to get the handle of the notepad window using partial caption.
C. Use the ShowWindow API to minimize the window
Code (tested in VBA-Powerpoint)
Paste this code in a module in the above PPTM
Private Declare Function FindWindow Lib "User32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) 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 Declare Function GetWindowTextLength Lib "User32" Alias _
"GetWindowTextLengthA" (ByVal hWnd As Long) As Long
Private Declare Function GetWindow Lib "User32" (ByVal hWnd As Long, _
ByVal wCmd As Long) As Long
Private Declare Function ShowWindow Lib "User32" (ByVal hWnd As Long, _
ByVal nCmdShow As Long) As Long
Private Const GW_HWNDNEXT = 2
Private Const SW_SHOWMINIMIZED = 2
Sub Sample()
Dim shp As Shape
Dim winName As String
Dim Ret As Long
For Each shp In ActivePresentation.Slides(1).Shapes
If shp.Type = msoEmbeddedOLEObject Then
winName = shp.Name
shp.OLEFormat.Activate
Exit For
End If
Next
If winName <> "" Then
Wait 1
If GetHwndFromCaption(Ret, Replace(winName, ".txt", "")) = True Then
Call ShowWindow(Ret, SW_SHOWMINIMIZED)
Else
MsgBox "Window not found!", vbOKOnly + vbExclamation
End If
End If
End Sub
Private Function GetHwndFromCaption(ByRef lWnd As Long, ByVal sCaption As String) As Boolean
Dim Ret As Long
Dim sStr As String
GetHwndFromCaption = False
Ret = FindWindow(vbNullString, vbNullString)
Do While Ret <> 0
sStr = String(GetWindowTextLength(Ret) + 1, Chr$(0))
GetWindowText Ret, sStr, Len(sStr)
sStr = Left$(sStr, Len(sStr) - 1)
If InStr(1, sStr, sCaption) > 0 Then
GetHwndFromCaption = True
lWnd = Ret
Exit Do
End If
Ret = GetWindow(Ret, GW_HWNDNEXT)
Loop
End Function
Private Sub Wait(ByVal nSec As Long)
nSec = nSec + Timer
While nSec > Timer
DoEvents
Wend
End Sub
My understanding is that you have control over how XML file gets embedded into PowerPoint presentation in the first place. Here I do not quite understand why you chose to keep the data you need as contents of an embedded object.
To be sure, the task of getting those contents back is not a piece of cake. Actually, as long as there is no (simple or even moderately difficult) way to call QueryInterface and use IPersist* interfaces from VBA, there is just one way to get to contents of embedded object. The way involves following steps:
Activate an embedded object. You used OLEFormat.DoVerb 1 for that. A better way would be to call OLEFormat.Activate, but this is irrelevant for your particular problem.
Use embedded object's programming model to perform useful operations like getting contents, saving or whatever is exposed. Notepad.exe exposes no such programming model, and you resorted to WinAPI which is the best choice available.
Unfortunately, your current approach has at least 2 flaws:
The one you identified in the question (activation of notepad.exe leading to possibility of user's interference).
If a user has default program for opening .txt files other than notepad.exe, your approach is doomed.
If you do have control over how embedded object is created then better approach would be to store your XML data in some property of Shape object. I would use Shape.AlternativeText (very straightforward to use; shouldn't be used if you export your .pptm to HTML or have some different scenario where AlternativeText matters) or Shape.Tags (this one is probably the most semantically correct for the task) for that.
I don't think that blocking the user is the right approach,
If you must use a content of a notepad window, I would suggest using the SendKeys method, in order to send this combination:
SendKeys("^A^C")
Which is the equivalent of "Select All" and "Copy",
And then you could continue working "offline" on the clipboard, without fear of interference by keystrokes.
My approach, per Sid's suggestion, was to find a way to minimize the Notepad.exe. Since I already found way to get that object and close it, I figured this should not be as hard.
I add these:
Public Declare Function _
ShowWindow& Lib "user32" (ByVal hwnd As Long, _
ByVal ncmdshow As Long)
Public Const SW_MINIMIZE = 6
And then, in the FindNotepad function, right before Exit Function (so, after the Notepad has been found) I minimize the window with:
ShowWindow TopWnd, SW_MINIMIZE