I want to execute a program from MS Access VBA Code. On click of a button, the program should execute.
I am using below code for this:
Dim myPath As String
myPath = "F:\MyExecutables\Prog_copy.exe"
iReturn = wsh.Run(myPath, windowStyle, waitOnReturn)
iReturn gives me 1 if the program executed successfully and 0 in case of any error or exception.
I want to get the exception details (at least the exception message) in VBA if the return value is 0.
How can do that.?
Note: I am using try catch blocks to handle different types of exceptions in my prg_Copy.exe.
Assuming your program outputs errors using StdErr, you can read errors using the following code:
Declare PtrSafe Sub SleepEx Lib "Kernel32.dll" (ByVal dwMilliseconds As Long, Optional ByVal bAlertable As Boolean = True)
Public Sub RunSomething()
Dim wsh As Object
Set wsh = CreateObject("WScript.Shell")
Dim myPath As String
myPath = "F:\MyExecutables\Prog_copy.exe"
Dim ex As Object
Set ex = wsh.Run("""" & myPath & """")
Do While ex.Status = 0 'WshRunning
SleepEx 50
Loop
If ex.Status = 2 'WshFailed
Debug.Print ex.StdErr.ReadAll 'Print any errors
End If
End Sub
Most console programs output errors to StdErr. If your program uses a different method of outputting errors, you need to use a different way to capture them.
Related
I have the following sub:
Public Sub ShellApp(URL As String)
Dim vResult As Long
vResult = ShellExecute(0, "open", URL, vbNullString, vbNullString, vbMinimizedFocus)
End If
End Sub
This is on a layer that cannot be changed due to several functionality needed on that sub.
Now, on our Main() sub for example, we check a list of added plugins saved in a text file beside the EXE, and call the above Sub in for loop with the path of the plugins to run them. So if I have 3 plugins as below in the text file:
C:\App1.EXE
C:\App2.EXE
C:\Users\AhmadMusa\AppData\Roaming\App3.exe
First two apps will run fine on all PCs (Static path), but third app will not work on any PC except mine which is not ok... Note that App3 always installed on AppData on any PC, so how to dynamically access it to run the app from any PC without adjustments on the sub.
What will be the path placed in the text file for third app so it can work on all PCs?
I tried (AppData\Roaming\App3.exe) but it does not work... I found on a thread (http://www.vbforums.com/showthread.php?529776-RESOLVED-Open-a-folder-in-AppData) that I can call something like (shell:AppData\Roaming\App3.exe) it did not work to run the App3.exe, but if I call (shell:AppData\Roaming) it will open the Roaming folder very well. But cannot run the EXE.
Any ideas ?
Thanks.
I believe that there is no way to solve the problem without altering the original procedure "ShellApp".
in case you change your mind, i think this post may come in help (with some tweekings)
Public Sub ShellApp(URL As String)
Dim vResult As Long
'vResult = ShellExecute(0, vbNullString, URL, vbNullString, vbNullString, vbNormalFocus)
vResult = ShellExecute(0, vbNullString, "cmd.exe", "/k """"" & URL & """""", vbNullString, vbNormalFocus)
End Sub
Private Sub Command1_Click()
ShellApp "%appdata%\PROGRAME.exe"
End Sub
this because only "cmd.exe" and ofcourse batch scripts are able to expend variables that are enclosed with percent character "%"
To close the console as soon as it starts change the parameter "/k" to "/c",
sub test()
dim tmp as string
tmp = environ("AppData ") & "\calc.exe"
call ShellExecute(..., tmp, ...)
end sub
fill the other arguments (...) the way you see it right
You need to expand the Environment variable (this is what the %...% does):
Debug.Print Environ("APPDATA") ' will print the expanded %appdata%
So, in your text file you should put:
%APPDATA%\App3.exe
How to expand the path? You can loop over the environment variables provided by the VB Environ function and do a string replace by yourself (the VB way) or you can profit from the ExpandEnvironmentStrings function (the Win32 API way).
Below a snippet using this second option:
Private Declare Function ExpandEnvironmentStrings Lib "kernel32.dll" _
Alias "ExpandEnvironmentStringsA" ( _
ByVal lpSrc As String, _
ByVal lpDst As String, _
ByVal nSize As Long) As Long
Public Function ExpandEnvironString(ByVal URL As String) As String
Dim buf As String, bufSize As Long
bufSize = ExpandEnvironmentStrings(URL, ByVal 0&, 0&)
buf = String(bufSize + 1, vbNullChar)
bufSize = ExpandEnvironmentStrings(URL, buf, Len(buf))
ExpandEnvironString = Left$(buf, InStr(1, buf, vbNullChar) - 1)
End Function
Before you call ShellApp(URL As String) you should expand the path:
URL = ExpandEnvironString(URL)
ShellExecute will receive the expanded path: C:\Users\AhmadMusa\AppData\Roaming\App3.exe
This is a non-breaking change, because if your initial default setting will be later changed to a custom fixed path, the ExpandEnvironmentStrings function will simply ignore it.
Example:
ExpandEnvironString("C:\App1.EXE ") will return C:\App1.EXE
More info:
you can get all your environment variables with following procedure:
Private Sub EnvironmentEntries()
Dim Entry As String, i As Long
i = 1
Do
Entry = Environ(i)
i = i + 1
If Entry = "" Then Exit Do
Debug.Print Entry
Loop
End Sub
... and check some additional info here:
Why are there directories called Local, LocalLow, and Roaming under \Users\?
I want to find the title of the window which is currently active(having focus) using Window Script Host(WSH) because I want my WSH script to Sendkeys only If the desired window is active.
Note* I am not in a condition to use the alternative i.e activating the desired window before invoking sendkeys.
Any help is appreciated.
Short answer: You can't. At least not without writing a COM wrapper for the relevant Windows API calls.
Can't you just use AppActivate and check the result?
Set oShell = CreateObject("WScript.Shell")
If oShell.AppActivate "Untitled - Notepad" Then
oShell.SendKeys "Hello, world!"
End If
Long answer: To get the active window title, you need to call the Windows API GetWindowText function and pass the GetForegroundWindow() handle. VBScript and Windows Script Host don't support Windows API calls, so you'll need to write a COM wrapper around these functions, that you can then use in your script. Here're examples:
Get current active Window title in C
How do I get the title of the current active window using c#?
You can make a COM object with GetForegroundWindow and GetWindowText.
Put following lines into wso.cls and store is a folder called wso on your desktop.
Imports System
Imports System.Runtime.InteropServices
Imports Microsoft.Win32
Namespace WindowScriptingObject
<Guid("7448E08D-ED0F-4E23-B528-91937BB41756"), _
InterfaceType(ComInterfaceType.InterfaceIsIDispatch)> _
Public Interface _WindowScriptingObject
<DispId(1)> Function ActiveWindow() As Integer
<DispId(2)> Function WindowText(ByVal hWnd As Integer) As String
End Interface
<Guid("B146BF9E-78FC-4DB0-ABFE-9FF026B43E4D"), _
ClassInterface(ClassInterfaceType.None), _
ProgId("WindowScriptingObject")> Public Class WindowScriptingObject
Implements _WindowScriptingObject
Public WindowScriptingObject()
Public Declare Auto Function GetForegroundWindow Lib "user32" Alias "GetForegroundWindow"() As Integer
Public Declare Auto Function GetWindowText Lib "user32.dll" (ByVal hwnd As Int32, <Out()> ByVal lpString As System.Text.StringBuilder, ByVal cch As Int32) As Int32
Public Function ActiveWindow() As Integer Implements _WindowScriptingObject.ActiveWindow
ActiveWindow=GetForegroundWindow()
End Function
Public Function WindowText(hwnd as Integer) As String Implements _WindowScriptingObject.WindowText
on error resume next
Dim b As New System.Text.StringBuilder(ChrW(0), 512)
Dim ret = GetWindowText(hWnd, b, b.Capacity)
WindowText = b.tostring
End Function
End Class
End Namespace
Then create a bat file in same folder called wso.bat.
"C:\Windows\Microsoft.NET\Framework\v4.0.30319\vbc.exe" /target:library /out:"%userprofile%\desktop\wso\wso.dll" "%userprofile%\desktop\wso\wso.cls" /verbose
"C:\Windows\Microsoft.NET\Framework\v4.0.30319\regasm" /codebase "%userprofile%\desktop\wso\wso.dll" /tlb:"%userprofile%\desktop\wso\wso.tlb" /v
If /i "%cmdcmdline:~0,6%"=="cmd /c" pause
To use in vbs after running bat file.
Set wso=CreateObject("WindowScriptingObject")
x = wso.ActiveWindow
msgbox x, , "vbs"
msgbox wso.windowtext(x), , "vbs"
The GUIDs used here are specific to this project. Do not use them for other purposes.
More info on what we are doing
http://social.msdn.microsoft.com/Forums/en-US/adcae113-4758-481a-a367-60d5d14d97d6/this-is-how-to-turn-vbs-and-js-files-into-exe-files-from-the-command-line-without-third-party-tools?forum=scripting
If you must do a per user install, use regasm to make a regfile instead of registering it. Then change all references to HKCR to HKCU\Software\Classes. Then merge with regedit /s regfile.reg.
To move the file you need to run Regasm on it in it's new location. See command in bat file.
Will be posed at MS site of course for accurate historical purposes.
This is an updated version for use. Previous answer is minimun needed for it to work.
This also replaces the answer here (appactivate between multiple internet explorer instances), as it didn't work for Windows 7 and later due to sendmail being a reserved name on those OSs.
Imports System
Imports System.Runtime.InteropServices
Imports Microsoft.Win32
Namespace WindowScriptingObject
<Guid("7448E08D-ED0F-4E23-B528-91937BB41756"), _
InterfaceType(ComInterfaceType.InterfaceIsIDispatch)> _
Public Interface _WindowScriptingObject
<DispId(1)> Function ActiveWindow() As UInteger
<DispId(2)> Function WindowText(ByVal hWnd As UInteger) As String
<DispId(3)> Function WindowPID(ByVal hWnd As UInteger) As UInteger
End Interface
<Guid("B146BF9E-78FC-4DB0-ABFE-9FF026B43E4D"), _
ClassInterface(ClassInterfaceType.None), _
ProgId("WindowScriptingObject")> Public Class WindowScriptingObject
Implements _WindowScriptingObject
Public WindowScriptingObject()
Public Declare Auto Function GetForegroundWindow Lib "user32" Alias "GetForegroundWindow"() As UInteger
Public Declare Auto Function GetWindowText Lib "user32.dll" (ByVal hwnd As Int32, <Out()> ByVal lpString As System.Text.StringBuilder, ByVal cch As Int32) As Int32
Public Declare Auto Function GetWindowThreadProcessId Lib "user32" Alias "GetWindowThreadProcessId" (ByVal hwnd As UInteger, ByRef lpdwProcessId As UInteger) As UInteger
Public Function ActiveWindow() As UInteger Implements _WindowScriptingObject.ActiveWindow
ActiveWindow = GetForegroundWindow()
If err.lastdllerror <> 0 then
Dim tmp as uinteger = err.lastdllerror and &h80070000
err.raise(tmp, "WindowSystemObject.GetForegroundWindow", "Type net helpmsg " & err.lastdllerror & " in a command prompt for help")
Exit Function
End If
End Function
Public Function WindowText(hwnd as UInteger) As String Implements _WindowScriptingObject.WindowText
Dim b As New System.Text.StringBuilder(ChrW(0), 512)
Dim ret as uinteger = GetWindowText(hWnd, b, b.Capacity)
If err.lastdllerror <> 0 then
Dim tmp as uinteger = err.lastdllerror and &h80070000
WindowText = ""
err.raise(tmp, "WindowSystemObject.GetWindowText", "Type net helpmsg " & err.lastdllerror & " in a command prompt for help")
Exit Function
End If
WindowText = b.tostring
End Function
Public Function WindowPID(HWnd as UInteger) As UInteger Implements _WindowScriptingObject.WindowPID
Dim X as UInteger
Dim M as UInteger = 1
X=GetWindowThreadProcessID(HWnd,M)
If err.lastdllerror <> 0 then
Dim tmp as uinteger = err.lastdllerror and &h80070000
WindowPID = 0
err.raise(tmp, "WindowSystemObject.GetWindowThreadProcessID", "Type net helpmsg " & err.lastdllerror & " in a command prompt for help")
Exit Function
End If
WindowPID = M
End Function
End Class
End Namespace
The batch file has to run without errors.
The first command makes the dll from the cls file. It will say Compilation Sucessfull. It expects the files to be in a folder called wso on your desktop.
The second command registers it per machine. You must be an admin to do this. If you are not an admin then you must generate a reg file, and change all HKEY_CURRENT_ROOT to HKEY_CURRENT_USER\Software\Classes.
To generate a regfile
"C:\Windows\Microsoft.NET\Framework\v4.0.30319\regasm" /regfile:"%userprofile%\desktop\wso\wso.reg" "%userprofile%\desktop\wso\wso.dll" /v
After editing wso.reg merge it with
regedit /m "%userprofile%\desktop\wso\wso.reg"
And you need to read the results of the commands.
Here is the script running showing hwnd, PID, and window title (and error code). Note how when script starts there is no active window for about two seconds (windows is waiting for your program to create one for it to make active. It only waits 2 seconds). Usually at program starts, but also other times, for short periods there will be no active window. You must trap this. Here's a script that does.
On error resume next
Set wso=CreateObject("WindowScriptingObject")
Do
x = wso.ActiveWindow
wscript.echo x
wscript.echo wso.windowtext(x)
wscript.echo (err.number)
err.clear
wscript.echo wso.windowpid(x)
wscript.echo (err.number)
err.clear
wscript.sleep 1000
Loop
And this is what it looks like when run with CScript in a command prompt.
C:\Users\User>cscript "C:\Users\User\Desktop\ActiveWindow.vbs"
Microsoft (R) Windows Script Host Version 5.7
Copyright (C) Microsoft Corporation. All rights reserved.
-2147024809
-2147024809
3344366
Administrator: Command Prompt - cscript "C:\Users\User\Desktop\ActiveWin
dow.vbs"
0
972
0
3344366
Administrator: Command Prompt - cscript "C:\Users\User\Desktop\ActiveWin
dow.vbs"
0
972
0
3344366
1312854
vbscript - How to find the window Title of Active(foreground) window using Windo
w Script Host - - Windows Internet Explorer
0
4724
0
1312854
vbscript - How to find the window Title of Active(foreground) window using Windo
w Script Host - - Windows Internet Explorer
0
4724
0
3344366
Administrator: Command Prompt - cscript "C:\Users\User\Desktop\ActiveWin
dow.vbs"
0
972
0
^C
C:\Users\User>
----EDIT----
It's looks like you've been hit by a notepad bug when pasting from web pages from the funny spacing of the object name in the error message.
If using notepad to write it copy and paste into wordpad to check line breaks. Notepad totally ignores and hides carriage returns but other programs don't. Notepad only looks for line feeds. If coping from browser based documentation such as web pages and help systems sometimes stray carriage returns get invisibly inserted in notepad.
If you have an embedded resource in your VB6 project that contains a binary file, what code would cause this file to be copied to another location, without ever making a copy of the file on the local system?
I have done something like this before in .NET but I fear it is not possible in VB6.
From http://support.microsoft.com/kb/q194409/ :
Public Function SaveResItemToDisk( _
ByVal iResourceNum As Integer, _
ByVal sResourceType As String, _
ByVal sDestFileName As String _
) As Long
'=============================================
'Saves a resource item to disk
'Returns 0 on success, error number on failure
'=============================================
'Example Call:
' iRetVal = SaveResItemToDisk(101, "CUSTOM", "C:\myImage.gif")
Dim bytResourceData() As Byte
Dim iFileNumOut As Integer
On Error GoTo SaveResItemToDisk_err
'Retrieve the resource contents (data) into a byte array
bytResourceData = LoadResData(iResourceNum, sResourceType)
'Get Free File Handle
iFileNumOut = FreeFile
'Open the output file
Open sDestFileName For Binary Access Write As #iFileNumOut
'Write the resource to the file
Put #iFileNumOut, , bytResourceData
'Close the file
Close #iFileNumOut
'Return 0 for success
SaveResItemToDisk = 0
Exit Function
SaveResItemToDisk_err:
'Return error number
SaveResItemToDisk = Err.Number
End Function
First, let me say that I'm not a Visual Basic 6 expert...
My need is to:
launch from a VB6 client code an exeternal .exe file
wait for the process to finish and - during its execution - read the messages coming from its standard output "on the fly" (so that I can print it on a text-filed widget or similars).
I'm wondering if it is even possible to do that in VB6...after a long search on the Internet I didn't come up with anything. Found a lot of examples of how to use the Shell function, but it seems to force me to read the stdout all at once when the process' execution is over, but I want to poll the process for "fresh" messages as they become available.
Any code snippets/suggestions/references are really appreciated.
Thanks in advance!
Use CreatePipe() to create an anonymous pipe that you can pass to CreateProcess().
You can then read from this pipe as required (either using polling or overlapped/async I/O.
This should give you enough info to find a good example.
You can always use Exec method of WshShell to do the job.
I prefer to use a home-grown API based solution cExec.cls much simpler than Bob Riemersma's user control (but not as versatile).
You can also create a batch file that has all the commands that you need to run, and then from VB6 call the batch file by executing
Shell "C:\YourPath\BatchFileName.bat > OutputFileName.txt" 'Overwrites OutputFilename.txt everytime
once you execute that, then open OutputFileName.txt and you will find all of the messages and output that was generated during the batch process. You can then read it in VB6 in a simple open "filename" for input as #1
You should also notice that if you use double GreaterThan symbols, the the output file will not be overwritten every time the batch runs. Instead, it will get appended with the new lines of output.
Shell "C:\YourPath\BatchFileName.bat >> OutputFileName.txt" 'This will append to OutputFileName.txt
Here is the function you want. The exercise of declaring the API (CreatePipe, CreateProcessA, CloseHandle, etc), the types (PROCESS_INFORMATION, STARTUPINFO, SECURITY_ATTRIBUTES) the constants (STARTF_USESTDHANDLES, STARF_USESHOWWINDOW, etc) are left to the reader.
Public Function ExecuteCommand(ByVal CommandLine As String, Optional bShowWindow As Boolean = False, Optional sCurrentDir As String) As String
Dim proc As PROCESS_INFORMATION 'Process info filled by CreateProcessA
Dim ret As Long 'long variable for get the return value of the
'API functions
Dim start As STARTUPINFO 'StartUp Info passed to the CreateProceeeA
'function
Dim sa As SECURITY_ATTRIBUTES 'Security Attributes passeed to the
'CreateProcessA function
Dim hReadPipe As Long 'Read Pipe handle created by CreatePipe
Dim hWritePipe As Long 'Write Pite handle created by CreatePipe
Dim lngBytesRead As Long 'Amount of byte read from the Read Pipe handle
Dim strBuff As String * 256 'String buffer reading the Pipe
'if the parameter is not empty update the CommandLine property
If Len(CommandLine) > 0 Then
mCommand = CommandLine
End If
'if the command line is empty then exit whit a error message
If Len(mCommand) = 0 Then
ApplicationEventLogError "Command Line empty in procedure ExecuteCommand of module modPipedOutput."
Exit Function
End If
'Create the Pipe
sa.nLength = Len(sa)
sa.bInheritHandle = 1&
sa.lpSecurityDescriptor = 0&
ret = CreatePipe(hReadPipe, hWritePipe, sa, 0)
If ret = 0 Then
'If an error occur during the Pipe creation exit
Debug.Print "CreatePipe failed. Error: " & Err.LastDllError & " (" & ReturnError(Err.LastDllError)
Exit Function
End If
'Launch the command line application
start.cb = Len(start)
start.dwFlags = STARTF_USESTDHANDLES Or STARTF_USESHOWWINDOW
'set the StdOutput and the StdError output to the same Write Pipe handle
start.hStdOutput = hWritePipe
start.hStdError = hWritePipe
' start.hStdInput = hInReadPipe
If bShowWindow Then
start.wShowWindow = SW_SHOWNORMAL
Else
start.wShowWindow = SW_HIDE
End If
'Execute the command
If Len(sCurrentDir) = 0 Then
ret& = CreateProcessA(0&, mCommand, sa, sa, 1&, _
NORMAL_PRIORITY_CLASS, 0&, vbNullString, start, proc)
Else
ret& = CreateProcessA(0&, mCommand, sa, sa, 1&, _
NORMAL_PRIORITY_CLASS, 0&, sCurrentDir, start, proc)
End If
If ret <> 1 Then
'if the command is not found ....
Debug.Print "File or command not found in procedure ExecuteCommand"
Exit Function
End If
'Now We can ... must close the hWritePipe
ret = CloseHandle(hWritePipe)
' ret = CloseHandle(hInReadPipe)
mOutputs = vbNullString
'Read the ReadPipe handle
Do
ret = ReadFile(hReadPipe, strBuff, 256, lngBytesRead, 0&)
mOutputs = mOutputs & Left$(strBuff, lngBytesRead)
'Send data to the object via ReceiveOutputs event
Loop While ret <> 0
'Close the opened handles
Call CloseHandle(proc.hProcess)
Call CloseHandle(proc.hThread)
Call CloseHandle(hReadPipe)
'Return the Outputs property with the entire DOS output
ExecuteCommand = mOutputs
End Function
In the Form_Load event of this ultralegacy app I need to transliterate over to a web app is this command/statement "WaitOn" that occurs right after the On Error GoTo...
Does anyone remember what WaitOn means?
Here's the code snippet:
Dim sCmd As String
Dim iFileHandle As Integer
Dim sFileName As String
Dim i As Integer
Dim sKeyWord As String
Dim sWindowPosition As String
Dim iWindowState As Integer
Dim sSystemId As String
Dim sMetrics() As String
On Error GoTo MainFormLoadErr
WaitOn
ReDim gsFundsUsed(0 To 0)
ReDim gsObjectsUsed(0 To 0)
Set gsActiveSpread = Nothing
.
.
.
MainFormLoadExit:
WaitOff
Close
Exit Sub
MainFormLoadErr:
MsgBox Error$(Err) & " in MainForm Load"
Resume MainFormLoadExit
There is a corresponding WaitOff down there I just found. I don't think WaitOn is part of a line label.
As #C-Pound Guru suggested, WaitOn and WaitOff were methods in one of the (many) modules of the program. Not clear from the the names of the subroutines was the fact that their task was to set the mouse pointer to the Wait Cursor, and then return to the default, later.
Sub WaitOn ()
On Error Resume Next
Screen.MousePointer = 11
End Sub
Sub WaitOff ()
On Error Resume Next
Screen.MousePointer = 0
End Sub
I've never come across a 'WaitOn' or 'WaitOff' command in VB. You might want to double-check the code to see if there's a WaitOn method written (and a WaitOff method as well). It's not a label as VB labels end with a colon (:).
What happens if you right-click and Go To Definition? And does the code currently run?
Check the references - maybe it's something from a non-standard dll.