將在VBA中執行的Shell命令的輸出配置到特定的Shell

Question

對於VBA我還是很新的，並且幾天前開始學習它。現在我正在嘗試創建一個宏來執行一個shell命令，並將輸出傳遞給特定工作表中的特定單元格。我試圖完成的是將目錄結構的文本轉儲到工作表中。以下是我目前的代碼。

Sub CopyList() 

    Call Shell("cmd.exe /S /K" & "dir /s /b directoryPath", vbNormalFocus) 

End Sub 

執行這個宏帶來了一個命令提示和轉儲cmd窗口內的目錄結構。我想知道如何將它傳遞給工作表。你的幫助將不勝感激。

Answer 1

一種方法是修改Call Shell到：

Call Shell("cmd.exe /S /K" & "dir /s /b directoryPath >C:\MyData\dir.txt", vbNormalFocus) 

這將創建文件夾中的文本文件「C：\ MyData的」（由您選擇的文件夾替換）含有什麼會去到控制檯。然後您可以打開文本文件並提取其內容。

VBA解決方案，響應加入到評論

如果你想要一個VBA解決方案，你有兩個選擇：功能Dir$和File Scripting Objects。

功能Dir$是較舊的功能。它提供帶有通配符的文件規格，但除了提供比File Scripting Objects更少的功能。我決定提供一個File Scripting Objects解決方案，因爲我幾乎總是發現它更有用。

我相信下面的代碼中的註釋充分解釋了我在做什麼，但不解釋我使用的VBA語句。一旦你知道一個聲明存在，很容易查找它。必要時提出問題，但越多，你可以發現自己，越快你將發展你的知識和技能。

' The subroutine ListFiles needs a reference to "Microsoft Scripting Runtime". 
' Within VBE, click Tools then References. If "Microsoft Scripting Runtime" is 
' not near the top and ticked, scroll down and click box to its left. 
Option Explicit 
Sub TestListFiles() 

    With Worksheets("Sheet1") 
    .Range("C1").Value = "Folder" 
    .Range("D1").Value = "File" 
    .Range("E1").Value = "Attributes" 
    .Range("F1").Value = "Last modified" 
    .Range("C1:F1").Font.Bold = True 
    End With 

    ' #### Replace parameters with ones appropriate for your system 
    ' #### if you want to use this test routine. 
    Call ListFiles("Sheet1", 2, 3, "C:\DataArea\NHSIC") 

End Sub 
Sub ListFiles(ByVal WshtName As String, ByVal RowTop As Long, _ 
       ByVal ColLeft As Long, ByVal FolderRootName As String) 

    ' Writes a list of all files within the folder named FolderRootName, 
    ' and its subfolders, starting at Worksheets(WshtName).Cells(RowTop, ColLeft) 

    Dim FileObj As File 
    Dim FileSysObj As FileSystemObject 
    Dim FolderNameCrnt As String 
    Dim FolderObj As Folder 
    Dim FolderSubObj As Folder 
    Dim FoldersToCheck As New Collection 
    Dim RowCrnt As Long 
    Dim Wsht As Worksheet 

    Application.ScreenUpdating = False 
    Set Wsht = Worksheets(WshtName) 
    RowCrnt = RowTop 

    Set FileSysObj = CreateObject("Scripting.FileSystemObject") 

    ' Prime FoldersToCheck with the root folder 
    FoldersToCheck.Add FolderRootName 

    Do While FoldersToCheck.Count > 0 

    ' Extract and delete first folder name in FoldersToCheck 
    FolderNameCrnt = FoldersToCheck(1) 
    FoldersToCheck.Remove (1) 

    ' Get folder object for first name in FoldersToCheck 
    Set FolderObj = FileSysObj.GetFolder(FolderNameCrnt) 

    ' Add any subfolders of current folder to FoldersToCheck ready to be 
    ‘ checked by a later repeat of this loop. 
    For Each FolderSubObj In FolderObj.SubFolders 
     FoldersToCheck.Add FolderNameCrnt & "\" & FolderSubObj.Name 
    Next 

    ' Output details of any files within current folder. I have output 
    ' more details than requested to give a hint of what is available. 
    For Each FileObj In FolderObj.Files 
     With Wsht 
     .Cells(RowCrnt, ColLeft).Value = FolderNameCrnt 
     .Cells(RowCrnt, ColLeft + 1).Value = FileObj.Name 
     .Cells(RowCrnt, ColLeft + 2).Value = AttrNumToNames(FileObj.Attributes) 
     With .Cells(RowCrnt, ColLeft + 3) 
      .Value = FileObj.DateLastModified 
      .NumberFormat = "d mmm yyyy" 
     End With 
     End With 
     RowCrnt = RowCrnt + 1 
    Next 
    DoEvents ' Allows code to be interrupted if necessary 
    Loop 

    Wsht.Columns.AutoFit 

    Application.ScreenUpdating = True 

End Sub 
Function AttrNumToNames(ByVal AttrNum As Long) As String 

    ' Convert an attribute number into the list of properties it represents 

    Dim Names As String 

    Names = "" 

    If AttrNum >= 128 Then 
    Names = "Compressed " & Names 
    AttrNum = AttrNum - 128 
    End If 
    If AttrNum >= 64 Then 
    ' Some documentation says this is only for Mac. Other documentation 
    ' implies it is also used with Windows. During my experimentation 
    ' I have not found any shortcut with it set. 
    Names = "Link " & Names 
    AttrNum = AttrNum - 64 
    End If 
    If AttrNum >= 32 Then 
    Names = "ToBeArchived " & Names 
    AttrNum = AttrNum - 32 
    End If 
    If AttrNum >= 16 Then 
    Names = "Directory " & Names 
    AttrNum = AttrNum - 16 
    End If 
    If AttrNum >= 8 Then 
    Names = "Label " & Names 
    AttrNum = AttrNum - 8 
    End If 
    If AttrNum >= 4 Then 
    Names = "System " & Names 
    AttrNum = AttrNum - 4 
    End If 
    If AttrNum >= 2 Then 
    Names = "Hidden " & Names 
    AttrNum = AttrNum - 2 
    End If 
    If AttrNum >= 1 Then 
    Names = "Read-only " & Names 
    AttrNum = AttrNum - 1 
    End If 
    If Names = "" Then 
    Names = "None" 
    End If 

    AttrNumToNames = Names 

End Function 

Answer 2

可以創建WScript.Shell對象，並直接讀取標準輸出：

Sub SO() 

Range("A1").Value = CreateObject("WScript.Shell").Exec("CMD /S /C dir /s /b directoryPath").StdOut.ReadAll 

End Sub