VBA to Prevent Keyboard Input While a Package Object (XML) is Read into ADODB Stream?

问题

I am developing an application which opens and reads an XML document previously embedded in a PowerPoint presentation, or a Word document. In order to read this object (xmlFile as Object) I have to do:

xmlFile.OLEFormat.DoVerb 1

This opens the package object, and I have another subroutine that gets the open instance of Notepad.exe, and reads its contents in to ADODB stream.

An example of this procedure is available on Google Docs:

XML_Test.pptm.

During this process there is a few seconds window where the Notepad.exe gains focus, and an inadvertent keystroke may cause undesired results or error reading the XML data.

I am looking for one of two things:

Either a method to prevent the user from inadvertently inputting (via keyboard/mouse/etc) while this operation is being performed. Preferably something that does not take control of the user's machine like MouseKeyboardTest subroutine, below. Or,
A better method of extracting the XML data into a string variable.

For #1: this is the function that I found, which I am leery of using. I am wary of taking this sort of control of the users system. ##Are there any other methods that I might use?##

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

For #2: Some background, but the issue seems to be the inability to extract the embedded object reliably using any method other than DoVerb 1. Since I am dealing with an unsaved document in an application (Notepad) that is immune to my VBA skillz, this seems to be the only way to do this. Full background on that, here:

Extracting an OLEObject (XML Document) from PowerPoint VBA

回答1:

My understanding is that you have control over how XML file gets embedded into PowerPoint presentation in the first place. Here I do not quite understand why you chose to keep the data you need as contents of an embedded object.

To be sure, the task of getting those contents back is not a piece of cake. Actually, as long as there is no (simple or even moderately difficult) way to call QueryInterface and use IPersist* interfaces from VBA, there is just one way to get to contents of embedded object. The way involves following steps:

Activate an embedded object. You used OLEFormat.DoVerb 1 for that. A better way would be to call OLEFormat.Activate, but this is irrelevant for your particular problem.
Use embedded object's programming model to perform useful operations like getting contents, saving or whatever is exposed. Notepad.exe exposes no such programming model, and you resorted to WinAPI which is the best choice available.

Unfortunately, your current approach has at least 2 flaws:

The one you identified in the question (activation of notepad.exe leading to possibility of user's interference).
If a user has default program for opening .txt files other than notepad.exe, your approach is doomed.

If you do have control over how embedded object is created then better approach would be to store your XML data in some property of Shape object. I would use Shape.AlternativeText (very straightforward to use; shouldn't be used if you export your .pptm to HTML or have some different scenario where AlternativeText matters) or Shape.Tags (this one is probably the most semantically correct for the task) for that.

回答2:

As you correctly guessed in the comment above that taking the focus away from notepad will solve your problem. The below code does exactly that.

LOGIC:

A. Loop through the shape and get it's name. In your scenario it would be something like Chart Meta XML_fbc9775a-19ea-.txt

B. Use APIs like FindWindow, GetWindowTextLength, GetWindow etc to get the handle of the notepad window using partial caption.

C. Use the ShowWindow API to minimize the window

Code (tested in VBA-Powerpoint)

Paste this code in a module in the above 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

回答3:

I don't think that blocking the user is the right approach,

If you must use a content of a notepad window, I would suggest using the SendKeys method, in order to send this combination:

SendKeys("^A^C")

Which is the equivalent of "Select All" and "Copy",

And then you could continue working "offline" on the clipboard, without fear of interference by keystrokes.

回答4:

My approach, per Sid's suggestion, was to find a way to minimize the Notepad.exe. Since I already found way to get that object and close it, I figured this should not be as hard.

I add these:

Public Declare Function _
     ShowWindow& Lib "user32" (ByVal hwnd As Long, _
                        ByVal ncmdshow As Long)
Public Const SW_MINIMIZE = 6

And then, in the FindNotepad function, right before Exit Function (so, after the Notepad has been found) I minimize the window with:

ShowWindow TopWnd, SW_MINIMIZE

来源：https://stackoverflow.com/questions/16348189/vba-to-prevent-keyboard-input-while-a-package-object-xml-is-read-into-adodb-st

标签

vba

ole

adodb

powerpoint-vba