Solved: launching a shell command silently from within VBA

[marekba]

Sorry, I post this question again in a new thread since the last one is "Solved" already

For launching a batch file "Silently" (without the black windows appearing), I usually use a vbs script with the following and launch the batch file via the latter:
[VBA]CreateObject("Wscript.Shell").Run """" & WScript.Arguments(0) & """", 0, False[/VBA]

This ",0,false" works only with the .run command though (see http://ss64.com/vb/run.html)

To use the StdOut.ReadAll in order to return a string with the message though, we must use the .Exec function, instead of .Run, but then we cannot have it silent... Do you know a workaround that would let a shell command be run from within VBA in silent mode and return a string?

Thanks for your help!

[stanl]

Have you looked at ShellExecute()?

[marekba]

Have you looked at ShellExecute()?

Hello Stanl, thanks for your reply!
If I understood well, this ShellExecute can be used to load another program from within VBA.

But I just want to run 1 command. For now, I use the following code :
[vba]
Dim strarr() As String
strarr() = Split(CreateObject("wscript.shell").exec("cmd /c " & strshellcommand).stdout.readall, vbCrLf)
[/vba] With this code, it returns the full message in my array, but I see the black window appearing. Will the ShellExecute run a single Shell command? And will it return the same kind of string as the .exec ? I couldn't manage to use the ShellExecute this way yet, but maybe I have missed some points. Any Idea?

[Kenneth Hobs]

A flash of the screen might be best for some scenarios if you like that method. If it is a simple task that takes little time, Stan's method should suffice.

Here are 3 methods. Obviously, you need to add Chip's ShellAndWait module if you want to try that though that method and Shell flash the command window.

[VBA]Option Explicit

Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long


' ShellAndWait
' By Chip Pearson, chip@cpearson.com, www.cpearson.com
' This page on the web site: www.cpearson.com/Excel/ShellAndWait.aspx
' 9-September-2008

Sub ken()
'ShellAndWait "c:\windows\explorer.exe /e,/root,c:\windows,w:\ken.txt", 1000, vbNormalFocus, PromptUser
Dim fn As String, s As String
fn = ThisWorkbook.Path & "\ken.txt"
s = "cmd /c dir x:\test\* /a:d /b > " & fn
'ShellAndWait s, 1000, vbMinimizedNoFocus, AbandonWait
'Shell s, vbMinimizedNoFocus
ShellExecute 0&, vbNullString, s, vbNullString, vbNullString, vbMinimizedNoFocus
MsgBox TXTStr(fn)
End Sub

Function TXTStr(filePath As String) As String
Dim str As String, hFile As Integer

If Dir(filePath) = "" Then
TXTStr = "NA"
Exit Function
End If

hFile = FreeFile
Open filePath For Binary Access Read As #hFile
str = Input(LOF(hFile), hFile)
Close hFile

TXTStr = str
End Function[/VBA]

[snb]

What you ask isn't possible I fear.

What you can do is to write a file and read it afterwards; but it is slower than using the exec().stdout.readall method

[VBA]Sub M_snb()
shell "cmd /c dir x:\test\*.xls /s /b > G:\OF\overview.txt" ,0,false

do until dir("G:\OF\overview.txt")<>""
DoEvents
loop

do until filelen("G:\OF\overview.txt")>0
DoEvents
loop

open "G:\OF\overview.txt" for input as #1
sn=split(input(LOF(1),1),vbcrlf)
close
end sub[/VBA]

[marekba]

Dear all,
Thank you for your quick replies. So it is as expected, it can only go through extra outpout file... I guess the macro will survive a few blinking windows, then, I want to avoid using extra files.
Thank you again

[Kenneth Hobs]

What blinking window? The ShellExecute method does not do that as explained.

[marekba]

Yes, but with ShellExecute using external text files to return the string cannot be avoided. This causes problem in our regulated environment where we do not have write access rights. Using the native string return is always possible.

[Kenneth Hobs]

I exported the data to an external file as I knew from your other thread what you were after in addition to what you asked in this thread.

You must have write access to your temp folder or many programs would fail.[vba]MsgBox Environ("temp")
'or
MsgBox Environ("tmp")[/vba]

Keep in mind, that there are other methods besides Shell methods to accomplish your goals. You just need to clearly state your goals. Also, when you get seemingly long code that solves a problem, don't think that just because there are many lines of code that it is not an efficient solution.

[marekba]

Dear Kenneth,

I fully agree with you. As you have noticed, my programming is far from optimal, and I am thriving for improving things. Every post you send gives me new knowledge, e.g. didn't know of this Environ(), which gives me many settings that I had to get by other means, less effective. I didn't know about the Split before, neither.
This is also a reason why I sometimes try to do things just for the purpose of seeing if they are possible or not.

Anyway, your help, from other members is always most appreciated ;D

[Kenneth Hobs]

Here is an fso method to get subfolders.

[VBA]Option Explicit

Dim dic As Object, fso As Object, subFolder As Object
Dim f As Object, fc As Object

Sub Test_SubFolders()
Dim x As Variant, longCount As Long, s() As String
x = SubFolders(ThisWorkbook.Path & "\..")
ReDim s(1 To UBound(x))
For longCount = 1 To UBound(x)
s(longCount) = x(longCount, 1)
Next longCount
MsgBox Join(s, vbLf)
End Sub

Function SubFolders(strDir As String) As Variant
Dim strName As String
Dim s As Variant, e As Variant
Dim cLong As Long

'strDir must not have a trailing \ for subFolders=True
If Right(strDir, 1) <> Application.PathSeparator Then _
strDir = strDir & Application.PathSeparator

'Exit if strDir does not exist
If Dir(strDir, vbDirectory) = "" Then Exit Function
Set fso = CreateObject("Scripting.FileSystemObject")
Set dic = CreateObject("Scripting.Dictionary")
recurseSubFolders fso.GetFolder(strDir)
ReDim s(1 To dic.Count, 1 To 1)
cLong = 0
For Each e In dic.keys
cLong = cLong + 1
s(cLong, 1) = CStr(e)
'Debug.Print cLong, e
Next e
Set subFolder = Nothing
Set fc = Nothing
Set f = Nothing
Set fso = Nothing
Set dic = Nothing
SubFolders = s
End Function

Private Sub recurseSubFolders(Folder As Object)
Set fc = Folder.SubFolders
For Each subFolder In fc
'Debug.Print subFolder.Path & "\"
dic.Add subFolder.Path & Application.PathSeparator, Nothing
recurseSubFolders subFolder
Next subFolder
End Sub

[/VBA]