Running dir in command prompt from vba - vba

Question

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.

Answer 1

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

Answer 2

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.

Answer 3

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