运行 命令提示符中的目录来自 vba
Running dir in command prompt from vba
尝试在命令提示符下使用 shell 命令将 VBA 转到 运行 目录：
Call Shell("Dir \rtserver\controlleddocuments\""incoming reports""\" & Left(cmbComponent.Column(1), 3) & "" & 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
如果我 debug.print shell 命令中的字符串，我得到：
Dir \rtserver\controlleddocuments\"incoming reports"917\*1702-1015* /b /a-d > C:\users\public\tmpcomponentsearch.txt
在命令提示符下 运行 没问题，但是当我尝试在 VBA 中 运行 时出现 'file not found' 错误。我宁愿不创建批处理文件来执行此操作。
提前致谢。
为什么要使用 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""917"
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 命令动态创建批处理文件，然后 运行 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
FSO 方法每次搜索大约需要 4-5 秒，但此方法执行时间不到 1 秒。动态地将命令直接输入命令提示符而无需每次都创建批处理文件仍然很好，但这目前有效。
这个问题（几乎）已经回答 here。
要从 VBA 中使用 Shell 运行 DOS 命令，命令行需要以 cmd.exe 和 /c 参数开头，然后是您的 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命令returns控制立即交给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对象有一个运行方法，运行是一个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
尝试在命令提示符下使用 shell 命令将 VBA 转到 运行 目录：
Call Shell("Dir \rtserver\controlleddocuments\""incoming reports""\" & Left(cmbComponent.Column(1), 3) & "" & 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
如果我 debug.print shell 命令中的字符串，我得到：
Dir \rtserver\controlleddocuments\"incoming reports"917\*1702-1015* /b /a-d > C:\users\public\tmpcomponentsearch.txt
在命令提示符下 运行 没问题，但是当我尝试在 VBA 中 运行 时出现 'file not found' 错误。我宁愿不创建批处理文件来执行此操作。
提前致谢。
为什么要使用 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""917"
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 命令动态创建批处理文件，然后 运行 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
FSO 方法每次搜索大约需要 4-5 秒，但此方法执行时间不到 1 秒。动态地将命令直接输入命令提示符而无需每次都创建批处理文件仍然很好，但这目前有效。
这个问题（几乎）已经回答 here。
要从 VBA 中使用 Shell 运行 DOS 命令，命令行需要以 cmd.exe 和 /c 参数开头，然后是您的 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命令returns控制立即交给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对象有一个运行方法，运行是一个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