从vba在命令提示符下运行dir

从vba在命令提示符下运行dir,vba,shell,ms-access,command-prompt,Vba,Shell,Ms Access,Command Prompt,正在尝试使用shell命令使VBA在命令提示符下运行dir: Call Shell("Dir \\rtserver\controlleddocuments\""incoming reports""\" & Left(cmbComponent.Column(1), 3) & "\20" & Left(lstComponentLots.Column(1), 2) & "\*" & lstComponentLots.Column(1) & "* /b /

正在尝试使用shell命令使VBA在命令提示符下运行dir:

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

如果我在shell命令中debug.print字符串,我会得到:

Dir \\rtserver\controlleddocuments\"incoming reports"\019\2017\*1702-1015* /b /a-d > C:\users\public\tmpcomponentsearch.txt
它在命令提示符下运行良好,但在VBA中运行时出现“未找到文件”错误。我不希望创建一个批处理文件来执行此操作


提前感谢。

为什么要使用
shell
?玩一玩FileSystemObject(添加对Microsoft脚本运行时的引用)。尝试以下几点:

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

我找到了一个答案——有点像。基本上,使用dir命令动态创建批处理文件,然后运行它:

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
FSO方法每次搜索大约需要4-5秒,但此方法在不到1秒的时间内执行。在每次不创建批处理文件的情况下,动态地将命令直接输入到命令提示符中仍然很好,但是现在可以了。

这个问题(几乎)已经得到了回答

要使用Shell从VBA中运行DOS命令,命令行需要以cmd.exe和/c参数开头,然后是DOS命令,如下所示:

Shell "cmd.exe /c [your DOS command here]".
例如,要使用DOS的ever-efficient DIR命令查找文件(本例中为公共控件库),请将(裸)结果放入文本文件中:

Shell "cmd.exe /c dir ""C:\Program Files (x86)\mscomctl.ocx"" /b /s > ""C:\MyResults.txt"""
请注意,Shell命令会立即将控制权返回给VBA,而不是等待DOS命令完成,因此我们需要等待文件创建并释放写锁,然后再使用它

例如:

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

我考虑过使用FSO,但根据我的经验,它比命令提示符中的dir搜索慢得多。我可以试一试,看看它在这里的表现如何。我用FSO试一试,它的运行速度比我想象的要快得多。谢谢你的意见。我仍然很好奇,怎么做,我最初尝试的方式,或是外壳真的保留调用程序(如.exe和.bat文件),而不是饲料的命令提示符行?我知道你会问这个!对不起,我已经想出了一个解决办法,但我没有尽力回答你原来的问题,我也不知道。很高兴你找到了适合你的东西。作为一种想法,这可能是一个异步执行问题吗?是否在Shell调用创建文件之前尝试执行import命令?您是否尝试过从“调试”窗口运行Shell调用,以查看文件是否已实际创建?或者,关于Shell被保留用于可执行命令文件,您可能是对的。这是一个很好的想法,因为我以前遇到过此类命令的异步问题,但是有一些方法可以运行Shell,以便vba在继续之前等待命令完成。在本例中,在继续之前,我确实尝试单独使用debug运行shell,但它给了我一个错误——从未有机会运行导入。
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