VBA Access中的Shell控制台命令无法正常运行

时间:2018-04-20 15:06:04

标签: vba shell ms-access cmd console

我的代码存在很大问题,我使用已知/某人解决方案创建了该代码。

发生了什么: 我需要一个代码,它将提供所有文件的摘录,其中lastDateModified比某个特定日期更早。但是最好的解决方案是,如果我将在阵列中收到这些文件名(不知道该怎么做“

问题: 当我在控制台中输入命令时,它会正确地为我提供文件列表。

然而,当我把它放在Access中时,它会给我发短信:

Microsoft Windows [版本6.1.7601] 版权所有(c)2009 Microsoft Corporation。保留所有权利。

I:\文件\存取>

代码:

Public Sub TestCommandLine()
    Const lngCancelled_c As Long = 0
    Dim strCmd As String

    strCmd = "cmd.exe forfiles /P directory /S /D +01/04/2015) > directory2"
    CommandLine strCmd, False
End Sub

Public Function CommandLine(command As String, Optional ByVal keepAlive As _
Boolean = False, Optional windowState As VbAppWinStyle = 
VbAppWinStyle.vbHide) _
As Boolean

 '--------------------------------------------------------------------------------
 ' Procedure : CommandLine
 ' Author    : Aaron Bush (Oorang)
 ' Date      : 10/02/2007
 ' Purpose   : Provides a simple interface to execute a command lines from VBA.
 ' Input(s)  :
 '               command     : The DOS command you wish to execute.
 '               keepAlive   : Keeps the DOS window open *after* command has been
 '                             executed. Default behavior is to auto-close. (See
 '                             remarks section for additional information.)
 '               windowState : Determines the window state of the DOS prompt
 '                             *during* command execution.
 ' Output    : True if completed with no errors, False if error encountered.
 ' Remarks   : If the windowState property is set to vbHide while the keepAlive
 '             parameter is set to True, then windowState will be changed to
 '             vbNormalFocus.
 '--------------------------------------------------------------------------------

On Error GoTo Err_Hnd
Const lngMatch_c As Long = 0
Const strCMD_c As String = "cmd.exe"
Const strComSpec_c As String = "COMSPEC"
Const strTerminate_c As String = " /c "
Const strKeepAlive_c As String = " /k "
Dim strCmdPath As String
Dim strCmdSwtch As String
    If keepAlive Then
        If windowState = vbHide Then
            windowState = vbNormalFocus
        End If
        strCmdSwtch = strKeepAlive_c
    Else
        strCmdSwtch = strTerminate_c
    End If
    strCmdPath = VBA.Environ$(strComSpec_c)
    If VBA.StrComp(VBA.Right$(strCmdPath, 7), strCMD_c, vbTextCompare) <> _
    lngMatch_c Then
         strCmdSwtch = vbNullString
    End If
    VBA.Shell strCmdPath & strCmdSwtch & command, windowState
    CommandLine = True
    VBA.Shell Nothing
    Exit Function
Err_Hnd:
    CommandLine = False
End Function

有人有这个问题吗?

2 个答案:

答案 0 :(得分:1)

使用此构造

Option Explicit

Public Sub Find_Files()
    Dim fileDetails() As String
    fileDetails = Split(CreateObject("wscript.shell").exec("cmd /c forfiles /P C:\Users\User\Desktop\TestFolder /S /D -19/04/2018").StdOut.ReadAll, vbCrLf)

    Dim i As Long
    For i = LBound(fileDetails) To UBound(fileDetails)
        If Not IsEmpty(fileDetails(i)) Then Debug.Print fileDetails(i)
    Next i
End Sub

答案 1 :(得分:0)

另一个问题是同样的问题 - 如何检查网络驱动器中的所有文件?

我已经尝试了

cmd /c pushd "network drive path" forfiles /S /D +14/04/2018

并且它不起作用,但是当我在控制台中以单独的行显示它时

pushd "network_drive"
forfiles /s /d +10/04/2018
popd

然后一切正常。 有什么想法吗?

解决:

fileDetails = Split(CreateObject("wscript.shell").exec("cmd /c pushd " & Chr(34) & IMPORT_PATH & FOLDER_PATH & Chr(34) & " & forfiles /S /D +" & s_date & " & popd").StdOut.ReadAll, Chr(10))

它适用于网络驱动器