Running dir in command prompt from vba - vba

Trying to get VBA to run dir in command prompt using a shell command:
Call Shell("Dir \\rtserver\controlleddocuments\""incoming reports""\" & Left(cmbComponent.Column(1), 3) & "\20" & Left(lstComponentLots.Column(1), 2) & "\*" & lstComponentLots.Column(1) & "* /b /a-d > C:\users\public\tmpcomponentsearch.txt", vbNormalFocus)
DoCmd.TransferText acImportDelim, "pathImport", "z_tmpcomponentsearch",
"C:\users\public\tmpcomponentsearch.txt"
Me.listScannedRecords.Requery
If I debug.print the string in the shell command I get:
Dir \\rtserver\controlleddocuments\"incoming reports"\019\2017\*1702-1015* /b /a-d > C:\users\public\tmpcomponentsearch.txt
which runs fine in command prompt, but I get a 'file not found' error when I try to run it in VBA. I'd rather not create a batch file to do this.
Thanks in advance.

Why use shell at all? Have a play with the FileSystemObject (add a reference to Microsoft Scripting Runtime). Try something along the lines of:
Dim fso As New FileSystemObject
Dim oFolder As Folder
Dim oFile As File
Dim strFolderName As String
strFolderName = "\\rtserver\controlleddocuments\""incoming reports""\019\2017"
Set oFolder = fso.GetFolder(strFolderName)
For Each oFile In oFolder.Files
If oFile.Name Like "*1702-1015*" Then
CurrentDb.Execute "INSERT INTO z_tmpcomponentsearch (col_name) " & _
"VALUES ('" & Replace(oFile.Name, "'", "''") & "')"
End If
Next oFile
Set oFile = Nothing
Set oFolder = Nothing
Set fso = Nothing

I found an answer - sort of. Basically create the batch file with the dir command in it on the fly and then run it:
Public Function search_with_batch_file(searchStr As String)
Const my_filename = "C:\Users\Public\qsd_search.bat"
Dim FileNumber As Integer
Dim wsh As Object
Dim waitOnReturn As Boolean: waitOnReturn = True
Dim windowStyle As Integer: windowStyle = 1
FileNumber = FreeFile
'creat batch file
Open my_filename For Output As #FileNumber
Print #FileNumber, "Dir " & searchStr & " /b /a-d >
C:\users\public\tmpcomponentsearch.txt"
Print #FileNumber, "exit"
Close #FileNumber
'run batch file and wait to complete
Set wsh = VBA.CreateObject("WScript.Shell")
wsh.Run my_filename, windowStyle, waitOnReturn
'Delete batch file
Kill my_filename
End Function
The FSO method was taking about 4-5 seconds to search each time but this method was executing in less than 1 second. It would still be nice to dynamically feed commands right into command prompt without creating a batch file each time, but this works for now.

This question is (almost) already answered here.
To run a DOS command from within VBA using Shell, the command line needs to begin with cmd.exe with the /c parameter, followed by your DOS command, like this:
Shell "cmd.exe /c [your DOS command here]".
For example, to use DOS's ever-efficient DIR command to find a file (the Common Controls Library in this case), putting the (bare) results into a text file:
Shell "cmd.exe /c dir ""C:\Program Files (x86)\mscomctl.ocx"" /b /s > ""C:\MyResults.txt"""
Note that the Shell command returns control immediately to VBA and does not wait for the DOS command to complete, so we need to wait for the file to be created, and the write lock released, before using it.
For example:
Sub ShellTest()
'Uses VBA Shell command to run DOS command, and waits for completion
Dim Command As String
Dim FileName As String
Dim FileHan As Long
Dim ErrNo As Long
'Set output file for results (NB folder must already exist)
FileName = "C:\Temp\Test.txt"
'Remove output file if already exists
If Dir(FileName) > "" Then Kill FileName
'Set command string
Command = "cmd.exe /c dir ""C:\Program Files (x86)\mscomctl.ocx"" /b /s >""" & FileName & """"
'Shell out to DOS to perform the DIR command
Shell Command
'Wait for file creation
Do While Dir(FileName) = ""
Debug.Print "Waiting for file creation...", Time
DoEvents
Loop
'Wait for write lock release
ErrNo = -1
Do While ErrNo <> 0
FileHan = FreeFile 'Find an available file handle
On Error Resume Next 'Disable error trapping while attempting to gain write lock
Open FileName For Append As #FileHan 'Attempt to gain write lock - will fail with error while write lock is held by DOS
ErrNo = Err.Number 'Save error number
On Error GoTo 0 'Re-enable error trapping
Close #FileHan 'Release write lock just obtained (if successful) - fails with no error if lock not obtained
Debug.Print "Waiting for write lock release...", Time
DoEvents
Loop
'Now we can use the results file, eg open it in Notepad
Command = "cmd.exe /c notepad.exe """ & FileName & """"
Shell Command
Debug.Print "Done"
End Sub
The WScript.Shell object has a Run method that runs a DOS command and waits for completion, which leads to simpler code (but you can't do anything in VBA while waiting for completion).
Sub ShellTest2()
'Uses WScript.Shell object to run DOS command and wait for completion
Dim Command As String
Dim FileName As String
Dim FileHan As Long
Dim ErrNo As Long
'Set output file for results (NB folder must already exist)
FileName = "C:\Temp\Test.txt"
'Remove output file if already exists
If Dir(FileName) > "" Then Kill FileName
'Set command string
Command = "cmd.exe /c dir ""C:\Program Files (x86)\mscomctl.ocx"" /b /s >""" & FileName & """"
'Use the WScript shell to perform the DOS command (waits for completion)
CreateObject("WScript.Shell").Run Command, 1, True 'Change 2nd parameter to 0 to hide window
'Now we can use the results file, eg open it in Notepad
Command = "cmd.exe /c notepad.exe """ & FileName & """"
Shell Command
Debug.Print "Done"
End Sub

Related

Call shell vs Wscript.Shell using cmd.exe

I am using the following code and it is working fine.
path = "cd C:\Program Files\bin & AppX File.txt"
Call Shell("cmd.exe /k " & path, vbNormalFocus)
However, I have to use the waitOnreturn so I changed to the following code and it is not working anymore.
path = "cd C:\Program Files\bin & AppX File.txt"
Dim wsh As Object
Dim waitOnReturn As Boolean: waitOnReturn = True
Dim windowStyle As Integer: windowStyle = 1
Set wsh = VBA.CreateObject("WScript.Shell")
wsh.Run ("cmd.exe /k " & path & ", windowStyle, waitOnReturn")
The error is " couldn't read file "File.txt,": no such file or directory " but the file is there.
The Filename is File.txt.
The program's name is AppX. The program allows me to run the file using cmd.exe if I first change the direction to the AppX path. Then, to run the file using cmd.exe, I need to run "AppX File.txt"
Is there something running with the WScript.Shell code
Because the file has spaces in its name, you need to enclose the path in quotation marks. So something like:
path = "cd \"C:\Program Files\bin & AppX File.txt\""
I changed
wsh.Run ("cmd.exe /k " & path & ", windowStyle, waitOnReturn")
to
wsh.Run "cmd.exe /k " & path, windowStyle, waitOnReturn
and it is working now

"WshShell The system cannot find the file specified Error 80070002"

I am using VBA to create some CSV files which are then used as references so that a batch file can use them as inputs. I have succeeded in making this work but found that I needed the VBA code to wait for the script to complete before continuing. From what I found on the web I should use the Windows Script Host Object Model" which would then allow me to set WaitOnReturn:=True. However I now get "Run-time error '-2147024894 (80070002)': Automation Error The system cannot find the file specified." This is obviously something elementary that I have missed but it is taking me hours to work out what it is. I have searched and not found an answer that seems to help. Here is the code that works, followed by the code that fails. Thanks in advance for any guidance.
Public Sub Create_run_delete_batch_file(Input_File)
Const MY_FILENAME = "E:\Test.bat"
Dim FileNumber As Integer
Dim retVal As Variant
FileNumber = FreeFile
'create batch file
Open MY_FILENAME For Output As #FileNumber
Print #FileNumber, "E:"
Print #FileNumber, "cd " & Chr(34) & "E:\Test_Dir\" & Chr(34)
'Set Current Risk File here
Print #FileNumber, "Script that works goes here" & Input_File
Close #FileNumber
'run batch file
retVal = Shell(MY_FILENAME, vbNormalFocus)
' NOTE THE BATCH FILE WILL RUN, BUT THE CODE WILL CONTINUE TO RUN.
If retVal = 0 Then
MsgBox "An Error Occured"
Close #FileNumber
End
End If
'Delete batch file
Kill MY_FILENAME
End Sub
Public Sub Create_run_delete_batch_file(Input_File)
Const MY_FILENAME = "E:\Test.bat"
Dim FileNumber As Integer
Dim retVal As Variant
Dim wsh As WshShell
Set wsh = New WshShell
FileNumber = FreeFile
'create batch file
Open MY_FILENAME For Output As #FileNumber
Print #FileNumber, "E:"
Print #FileNumber, "cd " & Chr(34) & "E:\Test_Dir\" & Chr(34)
'Set Current Risk File here
Print #FileNumber, "Script that works goes here" & Input_File
Close #FileNumber
'run batch file
'retVal = Shell(MY_FILENAME, vbNormalFocus)
retVal = wsh.Run(MY_FILENAME, WaitOnReturn:=True)
' NOTE THE BATCH FILE WILL RUN, BUT THE CODE WILL CONTINUE TO RUN.
If retVal = 0 Then
MsgBox "An Error Occured"
Close #FileNumber
End
End If
'Delete batch file
Kill MY_FILENAME
End Sub

Run bat file from Excel using VBA

I have test.bat file contains script:
copy host_name table_name -p table_name -t "file.csv"
Normally when I click on it, it's working fine. Now, I want to run test.bat file from Excel using vba.
strPath = ws1.Range("G2").value & "\" 'Directory to folder with bat
Shell strPath & "\test.bat", vbNormalFocus
something is wrong, because I see only snapshot/clip: like something is open and close into one sec...
just resolved it:
ChDir ThisWorkbook.Path & "\folder\"
Shell ThisWorkbook.Path & "\folder\test.bat", vbNormalFocus
im not sure with VBA and shell you using, but try something like this
Dim winShell As Object: Set winShell = CreateObject("WScript.Shell")
Dim WaitOnReturn As Boolean: WaitOnReturn = False
Dim windowStyle As Integer: windowStyle = 1
'Run the desired pair of shell commands in command prompt.
Call winShell.Run("cmd /k " & command1 & " & " & command2, windowStyle, WaitOnReturn)
'Release pointer to the command prompt.
Set winShell = Nothing
just replace my commands with your command(s) and lets see if its works
edit: just for completion my commands looks like this
Dim command1 As String: command1 = "cd /d" & projectDirectoryCell.Value
Dim command2 As String: command2 = "create_sensi.bat"

Can't delete VBScript file after running it

I'm simulating multi-threading with VBA, the code creates multiple vbs files and runs them. But i am not able to delete them after they are completed, it says "can not find script file" Here is my code:
' Write VBScript file to disk
sFileName = ActiveWorkbook.Path & "\Thread_" & agentNr & ".vbs"
intFileNum = FreeFile
Open sFileName For Output As intFileNum
Print #intFileNum, s
Close intFileNum
' Run VBScript file
Set wshShell = CreateObject("Wscript.Shell")
wshShell.Run """" & sFileName & """"
Kill sFileName
Set wshShell = Nothing
Any idea? Thanks
In our original code, as it's in asynchronous mode, Shell has not read the script file before you removing it.
Now I suggest a self-destruction mode.
As comments, we run .vbs again in an asynchronous mode, but the script file will be removed at the end of the vbscript, ie, inside the script itself. The deletion instructions are appended at the end of the VBScript to be created:
Sub sof20351356RunVbScript()
Dim intFileNum As Integer
Dim agentNr As Long
Dim sFileName As String, s As String
Dim wshShell
agentNr = 5
' Write VBScript file to disk
sFileName = ActiveWorkbook.Path & "\Thread_" & agentNr & ".vbs"
'
' In the file, we do our job normally,
' at the end, we kill the vbscript inside the script itself:
'
s = "MyVar = 1" & vbCrLf _
& "'... do foo bar" & vbCrLf
'
' now add the Killing order:
s = s _
& "Set fso = CreateObject(""Scripting.FileSystemObject"")" & vbCrLf _
& "fso.DeleteFile """ & sFileName & """" & vbCrLf
intFileNum = FreeFile
Open sFileName For Output As intFileNum
Print #intFileNum, s
Close intFileNum
' Run VBScript file
Set wshShell = CreateObject("Wscript.Shell")
'
' in synchronous mode:
'wshShell.Run """" & sFileName & """", 0, True
'
' in asynchronous mode:
wshShell.Run """" & sFileName & """", 0, False
'Kill sFileName
Set wshShell = Nothing
End Sub
Ref: http://msdn.microsoft.com/en-us/library/d5fk67ky(v=vs.84).aspx
As I tested so confirmed, before a script begins to run, it's read at 100% in memory by the Shell (Windows Script Interpreter), so the file itself has no more any importance when it starts executing. As a consequence, you can even add the destruction instruction at the beginning of the VBscript, before your true job.
But cmd.exe .bat file cannot be handled as this.
You're trying to delete a script file that is currently running. That's probably what is causing your problem.
How about using the wshShell.Exec method instead of Run? That way you can keep track of whether the VBScript is done running or not, and delay deleting the VBS file until it is done.
Proof-of-concept, not tested:
Dim oExec
Set oExec = wshShell.Exec("sFileName")
'Can launch more processes here...
'Now check if oExec process is done
Do While oExec.Status = 0
'oExec process not done yet...
WScript.Sleep 100
Loop
'It's done. Delete the file.
Kill sFileName
This is of course a simplistic example with only one process. You could launch more of them and store their handles (like oExec) in an array/collection/dictionary. Then periodically check all the handles in succession until they are all done running.

put batch file command into VBA Excel

Here is batch file code:
#echo off >summary.txt (
for %%F in (*chkpackage.log) do findstr /l %1 "%%F" nul||echo %% F:N/A:N/A:N/A:N/A:N/A:N/A:N/A:N/A:N/A:N/A:N/A:N/A:N/A:N/A:N/A:N/A:N/A:N/A)
and here is the code in VBA Excel calling the batch file:
FileSet = Sheet1.Range("C13")
txtFpath = Sheet1.Range("C7").Value
FilePath = txtFpath & "\res.bat"
ChDrive "D"
RSP = Shell(Environ$("COMSPEC"), vbNormalFocus)
Application.Wait Now + TimeValue("00:00:03")
SendKeys "CD " & txtFpath & "{ENTER}", True
Application.Wait Now + TimeValue("00:00:03")
SendKeys "start " & FilePath & " " & FileSet & "{ENTER}", True
Application.Wait Now + TimeValue("00:00:03")
SendKeys "exit " & "{ENTER}", True
Application.Wait Now + TimeValue("00:00:03")
SendKeys "exit " & "{ENTER}", True
But I don't want to use a batch file. I want to change it into command to use on VBA.
So i can use only VBA and run command line instead of using VBA to call batch and command line.
Easy explanation is I want to put that command in batch file into Excel-VBA and run it by using VBA call cmd and auto input that command to cmd like that Sendkeys code.
You can add a reference to the Microsoft Scripting Runtime (Tools -> References from the VBA IDE), which provides the FileSystemObject and allows you to do the following:
Dim fso As New FileSystemObject
Dim fle As Variant
For Each fle In fso.GetFolder(txtFpath).Files
'processing here
Next
You can limit the files to a particular pattern using the Like operator:
For Each fle In fso.GetFolder(txtFpath).Files
If fle.Name Like "*chkpackage.log" Then
'processing here
End If
Next
You can use the OpenAsTextStream method to get a TextStream object, and the ReadAll method to read the file contents:
For Each fle In fso.GetFolder(txtFpath).Files
If fle.Name Like "*chkpackage.log" Then
Dim txt As TextStream, contents As String
Set txt = fle.OpenAsTextStream(ForReading)
contents = txt.ReadAll
txt.Close
'process contents of file here
End If
Next
You can use Split(contents, vbCrLf) to split the contents into an array of lines before parsing (use vbLf or vbCr if the line delimiter is Unix/Mac and not Windows).
Alternatively, you can use the ReadLine method to read the file line by line. You need to check the AtEndOfStream property to ensure that you're not trying to read past the end of the file:
'Within the For Each loop
Dim txt As TextStream, currentLine As String
Set txt = fle.OpenAsTextStream(ForReading)
Do While Not txt.AtEndOfStream
currentLine = txt.ReadLine
'process current line here
Loop
txt.Close