Question

尝试使用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命令中调试了字符串，我得到：

Dir \\rtserver\controlleddocuments\"incoming reports"\019\2017\*1702-1015* /b /a-d > C:\users\public\tmpcomponentsearch.txt

在命令提示符下运行正常，但是当我尝试在VBA中运行它时，我收到“找不到文件”错误。我宁愿不创建批处理文件来执行此操作。

提前致谢。

Answer 1

为什么要使用shell？玩一下FileSystemObject（添加对Microsoft Scripting Runtime的引用）。尝试以下方面：

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

我找到了答案 - 有点像。基本上在运行中使用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秒的时间内执行。在没有每次创建批处理文件的情况下动态地将命令直接输入命令提示符仍然是很好的，但现在这样做。

Answer 3

（几乎）这个问题已经回答here。

要使用Shell在VBA中运行DOS命令，命令行需要以带有/ c参数的cmd.exe开头，然后是DOS命令，如下所示：

Shell "cmd.exe /c [your DOS command here]".

例如，要使用DOS高效的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

WScript.Shell对象具有一个Run方法，该方法运行DOS命令并等待完成，这导致代码更简单（但是等待完成时，您无法在VBA中执行任何操作）。

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

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

3 个答案: