Running dir in command prompt from 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