VBA 在将包对象 (XML) 读入 ADODB 流时防止键盘输入？

Question

我正在开发一个应用程序，它可以打开并读取以前嵌入在 PowerPoint 演示文稿或 Word 文档中的 XML 文档。为了读取这个对象( xmlFile as Object )，我必须这样做:
xmlFile.OLEFormat.DoVerb 1
这将打开包对象，我有另一个子例程，它获取 Notepad.exe 的打开实例，并将其内容读入 ADODB 流。

Google Docs 上提供了此过程的示例:

XML_Test.pptm .

在此过程中，Notepad.exe 会在几秒钟的窗口中获得焦点，无意中的击键可能会导致不希望的结果或读取 XML 数据时出错。

我正在寻找以下两件事之一:

一种防止用户在执行此操作时无意输入(通过键盘/鼠标/等)的方法。最好是不控制用户机器的东西，比如 MouseKeyboardTest子程序，如下。或者，

一种将 XML 数据提取到字符串变量中的更好方法。

对于#1:这是我发现的功能，我对使用持怀疑态度。我对采取这种对用户系统的控制持谨慎态度。 ##我还有其他方法可以使用吗？##

Private Declare Function BlockInput Lib "USER32.dll" (ByVal fBlockIt As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub MouseKeyboardTest() 'both keyboard and mouse blocked

    BlockInput True ' Turns off Keyboard and Mouse
'   Routine goes here
    Sleep 5000 ' Optional coding
    BlockInput False ' Turns on Keyboard and Mouse

End Sub

对于#2:一些背景知识，但问题似乎是无法使用 DoVerb 1 以外的任何方法可靠地提取嵌入对象.由于我正在处理不受我的 VBA Skillz 影响的应用程序(记事本)中未保存的文档，因此这似乎是执行此操作的唯一方法。完整的背景，在这里:

Extracting an OLEObject (XML Document) from PowerPoint VBA

Answer 1

正如您在上面的评论中正确猜到的那样，将注意力从记事本上移开将解决您的问题。下面的代码正是这样做的。

逻辑 :

一个 .循环遍历形状并得到它的名字。在您的情况下，它将类似于 Chart Meta XML_fbc9775a-19ea-.txt


乙 .使用 API，如 FindWindow , GetWindowTextLength , GetWindow等使用 获取记事本窗口的句柄部分标题 .

中号 .使用 ShowWindow最小化窗口的API

代码(在 VBA-Powerpoint 中测试)

将此代码粘贴到上述 PPTM 中的模块中

Private Declare Function FindWindow Lib "User32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) 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 GetWindowTextLength Lib "User32" Alias _
"GetWindowTextLengthA" (ByVal hWnd As Long) As Long

Private Declare Function GetWindow Lib "User32" (ByVal hWnd As Long, _
ByVal wCmd As Long) As Long

Private Declare Function ShowWindow Lib "User32" (ByVal hWnd As Long, _
ByVal nCmdShow As Long) As Long

Private Const GW_HWNDNEXT = 2
Private Const SW_SHOWMINIMIZED = 2

Sub Sample()
    Dim shp As Shape
    Dim winName As String
    Dim Ret As Long

    For Each shp In ActivePresentation.Slides(1).Shapes
        If shp.Type = msoEmbeddedOLEObject Then
            winName = shp.Name
            shp.OLEFormat.Activate
            Exit For
        End If
    Next

    If winName <> "" Then
        Wait 1

        If GetHwndFromCaption(Ret, Replace(winName, ".txt", "")) = True Then
           Call ShowWindow(Ret, SW_SHOWMINIMIZED)
        Else
            MsgBox "Window not found!", vbOKOnly + vbExclamation
        End If
    End If
End Sub

Private Function GetHwndFromCaption(ByRef lWnd As Long, ByVal sCaption As String) As Boolean
    Dim Ret As Long
    Dim sStr As String

    GetHwndFromCaption = False

    Ret = FindWindow(vbNullString, vbNullString)

    Do While Ret <> 0

        sStr = String(GetWindowTextLength(Ret) + 1, Chr$(0))
        GetWindowText Ret, sStr, Len(sStr)
        sStr = Left$(sStr, Len(sStr) - 1)
        If InStr(1, sStr, sCaption) > 0 Then
            GetHwndFromCaption = True
            lWnd = Ret
            Exit Do
        End If
        Ret = GetWindow(Ret, GW_HWNDNEXT)
    Loop
End Function

Private Sub Wait(ByVal nSec As Long)
    nSec = nSec + Timer
    While nSec > Timer
        DoEvents
    Wend
End Sub