VB6 - ShellExecute not working - vb6

I have been trying to open a file using ShellExecute method in VB6, filename will be taken from a textbox within the form. But the file doesn't open and no errors too.
However the same method works smooth if i pass the file name directly instead of referring from a variable. Code below for reference. Not sure where problem exists but any help is much appreciated.
WorkingCode
ShellExecute 0, vbNullString, "F:\Desktop\SBKL\template.xlsx", vbNullString, vbNullString, vbNormalFocus
NonWorking Code
Dim FlNme As String
FlNme = Trim(Me.T_Doc_Link.Text)
ShellExecute 0, vbNullString, FlNme, vbNullString, vbNullString, vbNormalFocus

Before to call ShellExecute() you should check if file exists using Dir$() and warning the user when the path and/or file are wrong:
If Dir$(FlNme, vbNormal) = vbNullString Then
MsgBox "File not found:" & vbCrLf & FlNme
Exit Sub
End If
ShellExecute 0, vbNullString, FlNme, vbNullString, vbNullString, vbNormalFocus

Related

VB6: ShellExecute an EXE inside AppData

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\?

VBA:IE-How to assign pathname to file input tag without popup file upload form?

I am currently doing automaiton for file uploading
Below is HTML tag for input file tag:
<input name="file" title="Type the path of the file or click the Browse button to find the file." id="file" type="file" size="20">
And below is button HTML Tag:
<input name="Attach" title="Attach File (New Window)" class="btn" id="Attach" onclick="javascript:setLastMousePosition(event); window.openPopup('/widg/uploadwaiting.jsp', 'uploadWaiting', 400, 130, 'width=400,height=130,resizable=no,toolbar=no,status=no,scrollbars=no,menubar=no,directories=no,location=no,dependant=no', true);" type="submit" value="Attach File">
My VBA coding is:
Dim filee As Object
Set filee = mydoc.getElementById("file")
filee.Value = filenamepath
Set attach = mydoc.getElementsByName("Attach")
attach(0).Click
When I am running this coding, input filepath box not assign path name so i am getting chose file path.
Find attach screenshot.
Finally i have tried below code but that send key not executing
Dim filee As Object
Set filee = mydoc.getElementById("file")
filee.Click
obj.SetText filename
obj.PutInClipboard
SendKeys "^v"
SendKeys "{ENTER}"
Set attach = mydoc.getElementsByName("Attach")
attach(0).Click
Set finall = mydoc.getElementsByName("cancel")
finall(0).Click
Kindly tell me the windows API program to assign my file name directory in fine name: input box on opened Choose File to Open explorer and click the open button.
I fixed this issue by running external VBScript contain file path to set it on 'Choose File to Upload' pop up window using SendKeys method after send Enter Key to close this pop up, and this run successfully because the extranl VBScript run on another process so it will not stuck on VBA code.
Notes:
1- I dynamically create the external VBScript from VBA code and save it on Temp folder after that I run this script using WScript.Shell.Run to excute it on another thread
1- At the begining of the external VBScript I set 1 sec delay to be sure the 'Choose File to Upload' pop up window already opened from VBA.
And here is the complete code:
....
....
Set filee = mydoc.getElementById("file")
CompleteUploadThread MyFilePath
filee.Foucs
filee.Click
....
....
Private Sub CompleteUploadThread(ByVal fName As String)
Dim strScript As String, sFileName As String, wsh As Object
Set wsh = VBA.CreateObject("WScript.Shell")
'---Create VBscript String---
strScript = "WScript.Sleep 1000" & vbCrLf & _
"Dim wsh" & vbCrLf & _
"Set wsh = CreateObject(""WScript.Shell"")" & vbCrLf & _
"wsh.SendKeys """ & fName & """" & vbCrLf & _
"wsh.SendKeys ""{ENTER}""" & vbCrLf & _
"Set wsh = Nothing"
'---Save the VBscript String to file---
sFileName = wsh.ExpandEnvironmentStrings("%Temp%") & "\zz_automation.vbs"
Open sFileName For Output As #1
Print #1, strScript
Close #1
'---Execute the VBscript file asynchronously---
wsh.Run """" & sFileName & """"
Set wsh = Nothing
End Sub
As setting the value of a file input element is disabled due to security reasons, the "send keys" method seems to be the only option for automating file uploads using the IE API.
I just stumbled over the same problem that the code after the Click does not seem to be executed - that is, unless the dialog is closed. This indicates that the Click method is blocking, making it impossible to interact with the dialog from within the macro.
I could solve that by using a different method to open the dialog: by setting the focus to the file element with Focus, and sending the space key with SendKeys.
In your case, replace
filee.Click
with
filee.Focus
SendKeys " "
leemes's method(Sending key to the file selection button on IE) is an easy way to automate the file selection procedure.
In addition, if IEObject.Visible sometimes fails to give focus to the IE Window,
we'd better send the IE window to the top-most position using Windows API before using 'SendKeys' like following:
#If VBA7 Then
Declare PtrSafe Function SetForegroundWindow Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As Any, ByVal lpWindowName As Any) As LongPtr
#Else
Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As Any, ByVal lpWindowName As Any) As Long
#End If
Sub Test()
'first create or get IE object
Set IE= ...
...
'second, send IE window to the foreground
Dim TargetWnd
TargetWnd = FindWindow("IEFrame", vbNullString) 'find IE window
If TargetWnd = 0 Then Debug.Print "Window not found." 'Else Debug.Print TargetWnd
SetForegroundWindow (TargetWnd)
'sendkeys
set filee = getElement....
filee.Focus
SendKeys " " 'send Space key instead of .Click method
SendKeys "filePath" ' "C:\path\filename" ' Type-in the filename
SendKeys "{Enter}" 'closes the file dialog
'finally submit
...
...
end Sub

excel copy and paste in Windows Search

I am using Excel 2010 and Windows 7 Pro. I want to copy one cell content into Windows Search box. How do I write a VBA for that?
Sub CopytoSearchWindow()
'CopytoSearchWindow Macro ' '
sCell = Range(Application.InputBox(Prompt:="Pick the Cell", Type:=8)).Value
You can use the Shell.Application object to do this in conjunction with sending some key strokes.
Example: (replace my searchString bit with whatever you like)
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub searchExample()
Dim searchCell As Range
Dim shellApp As Object
Dim wshShell As Object
On Error Resume Next 'to catch if user presses cancel
Set searchCell = Application.InputBox(Prompt:="Pick the Cell", Type:=8)
On Error Goto 0
If searchCell Is Nothing Then Exit Sub
Set shellApp = CreateObject("Shell.Application")
Set wshShell = CreateObject("WScript.Shell")
shellApp.FindFiles
Sleep 500
wshShell.SendKeys searchCell.Value & "{enter}"
End Sub
Shell.Application reference: http://msdn.microsoft.com/en-us/library/windows/desktop/bb773938%28v=vs.85%29.aspx
Windows scripting host Shell reference: http://msdn.microsoft.com/en-us/library/aew9yb99%28v=vs.84%29.aspx

Redirect output of shell commands to file

I am running following command from Command Prompt
dir > c:\log.txt 2>&1
The out is directed to c:\log.txt file successfully.
Then, running the same command using CreateProcessA as below and nothing happens
Public Function ExecCmd(cmdline$)
Dim proc As PROCESS_INFORMATION
Dim start As STARTUPINFO
Dim ret As Long
start.cb = Len(start)
start.dwFlags = 1
start.wShowWindow = 1
ret& = CreateProcessA(vbNullString, cmdline$, 0&, 0&, 1&, NORMAL_PRIORITY_CLASS, 0&, vbNullString, start, proc)
ret = WaitForSingleObject(proc.hProcess, INFINITE)
Call GetExitCodeProcess(proc.hProcess, ret&)
Call CloseHandle(proc.hThread)
Call CloseHandle(proc.hProcess)
ExecCmd = ret&
End Function
Here cmdline$ is passed as dir > c:\log.txt 2>&1
I have tried Batch file - How to redirect output from exe after it has terminated? and Display & Redirect Output
Please suggest what is wrong here
Why don't you use the shell function? Here is an example of how to redirect the output:
Option Explicit
Private Sub Form_Load()
ExecCmd "dir >c:\log.txt 2>&1"
End Sub
Private Sub ExecCmd(cmdline As String)
Shell "cmd /c " & cmdline, vbHide
End Sub

Shell process' standard output reading in Visual Basic 6

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

Resources