在 VBA 中使用控制台作为调试窗口

Question

所以我在 Excel 文档中运行了一些宏，并想知道是否有一种方法可以频繁地将文本输出到控制台窗口（基本上就像直接窗口一样使用它）。

我知道将文本写入文件有多种方法，我只想在不使用即时窗口或 Excel 本身内部的其他窗口的情况下显示正在运行的进程的一些信息。

使用它可以帮助我显示单行，但我不想为每一行打开一个新窗口：

Call Shell("cmd.exe /K echo testInfo", vbNormalFocus)

我不想运行命令（可能除了 echo？）来执行任务，它只是应该显示文本。

提前感谢您的任何建议。

编辑：

作为对@JohnRC 帖子的补充，我找到了一个没有外部应用程序的解决方案：

Call Shell("PowerShell.exe -noexit -command get-content " + strPath + " -wait")

在运行上述命令后将信息记录到该位置的文本文件就可以了。

Answer 1

好的，因为我之前的回答遭到了一些反对，我想我应该尝试为请求提供一个实际的答案，即提供一种将日志消息发送到命令提示符窗口的方法。来了……

这个解决方案是作为一个 VBA 类实现的，它会将消息作为注释行发送到标题中包含文本“ExcelLog”的单独运行的命令提示符窗口。此命令提示符必须单独启动。最简单的方法是创建一个名为“ExcelLog”的快捷方式来运行 CMD，然后当打开此快捷方式时，命令提示符窗口的标题中会出现“ExcelLog”。

在电子表格中添加 cConsole 类的代码（如下），然后在您的 VBA 代码中创建该类的全局实例并使用方法 .W "message" 将文本消息作为注释行发送到控制台（在这种情况下，使用前缀:: 将其标识为注释）。

cConsole 类查找具有必要标题的任何命令提示符窗口，然后将注释消息发送到该窗口。如果找不到该窗口，它只是跳过该操作，以便 Excel VBA 代码继续执行而不报告错误。此外，如果您在 Excel VBA 开始运行后打开命令提示符窗口，cConsole 将自动连接到该窗口并开始/恢复发送消息。这意味着您可以随时关闭并重新打开命令提示符 ExcelLog 窗口，而不会中断 VBA 代码的执行。

这似乎适用于我的设置。我认为这比简单地拖尾一个文本文件要麻烦一些，但是 - 嘿，你付了钱，然后做出选择。

这是 cConsole 类的代码。

Option Explicit

'// cConsole class
'// This class wraps an interface to a separately-started command prompt
'// window to which messages are sent as comments, so that the command prompt
'// window can be used as a real-time scrolling log from Excel.

'// Each instance of this class creates its own connection to the
'// command prompt window which must have a title containing the text
'// "ExcelLog". If such a window is not open then messages are not
'// logged. The command prompt window can be opened after messages
'// have started, and it will be connected when the next message is
'// sent.

'// The simplest way to set up the necessary command prompt window is to
'// create a shortcut on the desktop the name "ExcelLog" which runs CMD

'// Usage - - - - - - - - - - - -
'//
'//     Dim oConsole As New cConsole
'//     :
'//     oConsole.W "Message to be written to the console"
'//


'// Windows functions to get window handles etc
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
(ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" _
(ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
(ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function SetForegroundWindow Lib "user32" _
  (ByVal hWnd As Long) As Long


'// Handle of the excel log window
Private hLogWindow As Long


Private Sub Class_Initialize()
'// On instantiation, attempts to find the ExcelLog window
    findExcelLogWindow

End Sub

Public Sub W(sMsg As String)
    '// Public function used to send the given message
    '// as a comment line to the linked window
   SendToConsole ":: " & sMsg
End Sub
Private Sub SendToConsole(Command As String)
    '// Connects to and sends a command line to the command prompt
    '// window that is being used as the log

    Dim res As Boolean

    '// Check that a connection has been made and
    '// attempt to connect if not
    If hLogWindow = 0 Then
        findExcelLogWindow
        If hLogWindow = 0 Then Exit Sub
    End If

        On Error Resume Next

                Do
                    '// Attempt to bring the logging window to the foreground
                     res = SetForegroundWindow(hLogWindow)

                    '// Check if successful, and send the command if so
                    If res Then
                        SendKeys Command & vbCrLf
                        Exit Do
                    Else
                        '// Not successful, so try reconnecting to the logging window
                        findExcelLogWindow

                        '// If we cannot connect, just exit without sending anything
                        If hLogWindow = 0 Then Exit Sub
                    End If

                Loop

                '// Check if there has been any error
                If Err.Number <> 0 Then
                    hLogWindow = 0
                    MsgBox "Error: " & Err.Number & vbCrLf & Err.Description
                End If

        On Error GoTo 0

End Sub
Private Function findExcelLogWindow() As Long
    '// This function looks for a command prompt window that has the text
    '// ExcelLog in the title
    Dim nLen As Long
    Dim sData As String

    Dim Class As String
    Dim Title As String

    '// Get handle to the first window
    hLogWindow = 0

    '// Check each window in turn
    Do

            hLogWindow = FindWindowEx(0&, hLogWindow, vbNullString, vbNullString)

            '// Check that a window was found
            If hLogWindow = 0 Then Exit Do

            '// Get the class name of the window
            sData = String$(100, Chr$(0))
            nLen = GetClassName(hLogWindow, sData, 100)
            Class = Left$(sData, nLen)

            '// Get the title of the window
            sData = String$(100, Chr$(0))
            nLen = GetWindowText(hLogWindow, sData, 100)
            Title = Left$(sData, nLen)

            '// Check if the required window has been found
            If Class = "ConsoleWindowClass" And InStr(Title, "ExcelLog") > 0 Then

                '// Initialise the window to remove any prompt text
                SendToConsole "PROMPT $S"

                '// Write some initial messages
                Me.W "*******************"
                Me.W "[" & ThisWorkbook.Name & "] connected to console at " & Now
                Me.W ""

                '// Return the handle to the log window
                findExcelLogWindow = hLogWindow
                Exit Function


            End If



    Loop

    '// The log window was not found, so return zero
    findExcelLogWindow = 0

End Function

我通过处理工作表中图像控件上的 MouseMove 事件对此进行了测试：

Option Explicit

Private oCons As New cConsole

Private Sub Image1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    oCons.W "MouseMove " & X & ", " & Y

End Sub

这是结果

Answer 2

我没有使用 shell 作为控制台来记录消息，而是使用文本文件来保存日志，并使用 tail 实用程序监视文件的输出（我使用了来自 http://www.baremetalsoft.com/wintail/ 的 WinTail，但我我确定还有其他人）。这是代码，我将其放入名为 Log 的单独 vba 模块中。然后调用 Log.W "Message" 来记录消息。

Option Explicit

'// You need a reference to "Microsoft Scripting Runtime" library in VBA
Private oLog As Scripting.TextStream
Private bErr As Boolean


Private Sub INIT()
    '// Initialise the output log file

    '// Check if log file is already open, or there has been an error
    If bErr Then Exit Sub
    If Not oLog Is Nothing Then Exit Sub


    '// Open the log file for appending
    Dim ofso As New Scripting.FileSystemObject
    On Error Resume Next
    Set oLog = ofso.OpenTextFile("excel.log", ForAppending, True)

    '// Check that open was successful
    If Err.Number <> 0 Then
        MsgBox "Log file error: " & Err.Number & ": " & Err.Description
        bErr = True

        Exit Sub
    End If
    On Error GoTo 0

    '// Write a starting block to the log
    oLog.WriteLine "*"
    W "********************************** START"
    W "* Start of log " & Format(Date, "YYYY-MM-dd")
    W ""

End Sub

Public Sub W(sMsg)
    '// Writes a single line message to the log
    '// Initialize if required
        INIT
    '// Check for log file error
        If bErr Then Exit Sub

    '// Create the log line and write to log file
        Dim st As String
        st = Format(Now, "hh:mm:ss ")
        oLog.WriteLine st & sMsg

End Sub

Public Function ReportErr(Optional Loc As Variant = "") As Boolean
    '// Reports information from the Err object, if an error has occured

    '// Check if error has occurred, exit if not
    If Err.Number = 0 Then ReportErr = False: Exit Function

    '// Set return value
    ReportErr = True

    '// Initialize if required
    INIT

    '// Check for log file error
    If bErr Then Exit Function

    '// Write the error block to the log
    W "*********** ERROR ******* " & IIf(Len(Loc) > 0, "[" & Loc & "]", "")
    W "* Error #" & Err.Number

    If Len(Err.Description) > 0 Then
        W "* : " & Err.Description
        W "*************************"
    End If

End Function

使用 WinTail 跟踪日志文件意味着日志的输出会立即出现，因此您可以在程序运行时监控日志。