I'm trying to have the user select an instance or open Workbook of Excel. The idea is to have a window that will display all open Instances of Excel and then display the Workbooks within these instances. I've done some self research and what I've found below...
Public Declare Function GetDesktopWindow Lib "user32" () As Long
Public 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
Function ExcelInstances() As Long
Dim hWndDesk As Long
Dim hWndXL As Long
'Get a handle to the desktop
hWndDesk = GetDesktopWindow
Do
'Get the next Excel window
hWndXL = FindWindowEx(GetDesktopWindow, hWndXL, _
"XLMAIN", vbNullString)
'If we got one, increment the count
If hWndXL > 0 Then
ExcelInstances = ExcelInstances + 1
End If
'Loop until we've found them all
Loop Until hWndXL = 0
End Function
Problem:
When I ran the code, I am getting the error message:
Compile Error:
Only comments may appear after End Sub, End Function or End Property
It's highlighting the first line in the code, and I believe it has something to do with the "user32" string?
Question:
This code will only give me a COUNT of how many instances of Excel are currently open. Is there any way to return the names of the instances and then another sub routine that would return the Workbooks within the instances as well? I've seen a solution making use of VB.Net; however I'd like to avoid this so that I can try to keep everything consolidated into a single Excel Spreadsheet (if possible).
Related
I need to be able to list all current Access applications. The GetObject command is well thought out, but it is not very efficient when it comes to simultaneously processing batches of read/write accdb files and ensure that there is only one Access instance per file. I found approaches to my problem in some rare places on the Net and I was actually able to tinker with exactly what I needed.
But my solution has some rather strange and annoying side effects: when I use it, Access instances don't really close but get invisible while keeping applications opened: I can't even make them visible again with .Visible= True, the action just don't work and I must kill them by hand. I have even seen remaining Access instances mixing in the task manager with the Excel instance Workbooks...
The fact is that I have very little knowledge of the Windows APIs that it implements: it's by chance if my solution works.
So I'm asking you here to help me finalize this code that does a simple thing, return a collection of Applications Access objects currently opened.
Here is the code:
Option Explicit
Private Declare Function GetDesktopWindow Lib "user32" () As Long
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 PtrSafe Function AccessibleObjectFromWindow Lib "oleacc" (ByVal hWnd As LongPtr, ByVal dwId As Long, riid As UUID, ppvObject As Object) As Long
Private Declare Function IIDFromString Lib "ole32" (ByVal lpsz As Long, ByRef lpiid As UUID) As Long
Private Type UUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type
Private Const IID_IDispatch As String = "{00020400-0000-0000-C000-000000000046}"
Private Const OBJID_NATIVEOM As Long = &HFFFFFFF0
Public Function AccessInstances() As Collection
Dim hWndDesk As LongPtr, hWnd As LongPtr
Dim iid As UUID, obj As Object
Dim acApp As Access.Application
Set AccessInstances = New Collection
hWndDesk = GetDesktopWindow
Do
hWnd = FindWindowEx(hWndDesk, hWnd, "OMain", vbNullString)
Call IIDFromString(StrPtr(IID_IDispatch), iid)
If AccessibleObjectFromWindow(hWnd, OBJID_NATIVEOM, iid, obj) = 0 Then
Set acApp = obj
AccessInstances.Add acApp
End If
Loop Until hWnd = 0
Set acApp = Nothing
End Function
The command that triggers the problems is AccessibleObjectFromWindow. I understand that there is an intermediate FindWindowEx call to do before invoking this command, but I ignore how it must be done, this totally out of my scope.
I thought that the Application Objects reserved by the collection could be what forces the application to stay open, but I never use them in a static or module level private variable, which implies that they are necessarily set to Nothing when the program stops, whether I do it myself explicitly or not, like in this example:
Sub ListAccessInstances()
Dim acApp As Access.Application
For Each acApp In AccessInstances
Debug.Print acApp.Name
Next
End Sub
Edit / additional information :
I was able to highlight the seemingly systematic problem that the function produces.
The principle is that the function produces side effects that do not exist when it is not used: Access instances remain open. A question that arises is whether or not these instances are empty. It seems to me that closing the last instance will totally close this leftover, but I am still uncertain when this may depend on the answer to the previous question.
The test procedure I have used is two-stage. A first procedure located in an Access database opens with the Shell command about ten other Access databases and a second one closes them (Getobject(aFile).Quit) . Thus an Access database remains always open.
The test consists in using or not using the incriminated function between the two procedures and to note what differs in the application manager, and also in the result of the function itself. This test is considered successful if there is no other instance left than the current one having used this function between the openings and closings. I remind you that this function is supposed to be purely readable and therefore without any consequence on the system.
1°) The test described above is generally positive: the instances are cleaned after they are closed. Nevertheless, I still saw one or two of them dragging.
2°) When you close the bases manually instead of using the closing procedure, the instances remain. Alexandru, could you try this test and tell me if you observe the same thing?
This is the demonstration, whose reproducibility I don't know yet, that the function does produce a system malfunction. In real work I had noticed that sometimes some instances still had their base (CurrentDb) open under the conditions I have described: locked in their invisibility. In fact, other visible effects in the task manager occur more or less randomly. For example to have an open and functional Access instance that does not appear in the task manager.
My approach to build this function has been very empirical. In particular, I learned from a code that allows the same thing with Excel. Since Excel is now mono-instance, I could not test this function, but I assume nevertheless that it is well written and that it works without side effects.
Here is the excerpt of the code we are interested in:
Function GetXLapp(hWinXL As Long, xlApp As Object) As Boolean
Dim hWinDesk As Long, hWin7 As Long
Dim obj As Object
Dim iid As GUID
Call IIDFromString(StrPtr(IID_IDispatch), iid)
hWinDesk = FindWindowEx(hWinXL, 0&, "XLDESK", vbNullString)
hWin7 = FindWindowEx(hWinDesk, 0&, "EXCEL7", vbNullString)
If AccessibleObjectFromWindow(hWin7, OBJID_NATIVEOM, iid, obj) = S_OK Then
Set xlApp = obj.Application
GetXLapp = True
End If
End Function
One can see that there are two successive window calls, this is the aspect I shunted in an experiment that was not supposed to work, but it still gave the result I have here. Functional, but producing instability. That's it, my question is whole, should we make this intermediate call with Access and if so how? Is it something else?, etc.
Try this
Private Declare PtrSafe Function AccessibleObjectFromWindow Lib "oleacc" (ByVal hWnd As LongPtr, ByVal dwId As Long, riid As Any, ppvObject As Object) As Long
Private Declare PtrSafe Function FindWindowExA Lib "User32" (ByVal hwndParent As LongPtr, ByVal hwndChildAfter As LongPtr, ByVal lpszClass As String, ByVal lpszWindow As String) As LongPtr
Public Function getAccessInstanceList() As Collection
Dim GUID&(0 To 3), acc As Object, hWnd
GUID(0) = &H20400
GUID(1) = &H0
GUID(2) = &HC0
GUID(3) = &H46000000
Set getAccessInstanceList = New Collection
Do
hWnd = FindWindowExA(0, hWnd, "OMain", vbNullString)
If hWnd = 0 Then Exit Do
If AccessibleObjectFromWindow(hWnd, &HFFFFFFF0, GUID(0), acc) = 0 Then
getAccessInstanceList.add acc.Application
End If
Loop
End Function
I'm making a tool, where I need to start a programm (which I want to code with VB) by using VBA in an Excle file. When I close that programm, it should give back a parameter to the VBA script.
I started just now with the VBA script and didn't code anything of the VB programm yet. But I need to know, what to write in the VBA script and wheter this is possible.
So it should work like this:
I'm in the Excel file and I press a button
The programm is starting (also getting a parameter from the Excel file, this is not that important yet)
In that programm I configurate some stuff
Closing that Programm it should give back a ID of that configuration
I'm getting back to the Excel file with this ID
Is this possible? And what do I need to write in the VBA script and in the Programm to give back a parameter?
I hope you understand what I mean and you can help me
You could set your VB .exe to return an Exit code. Just make sure the id isn't 0 (means ran successfully) or 259 (calling process will think process is still running). The VBA below runs an .exe, waits for it to close, then returns the exit code.
Option Explicit
' Api declarations
Private Declare Function GetExitCodeProcess Lib "Kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
Private Declare Function OpenProcess Lib "Kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
Public Function RunProgram(ByVal strFilename As String) As Long
'# PURPOSE: Run a program, wait until closed, and return the exit code
Dim TaskID As Long
Dim hProc As Long
Dim lExitCode As Long
Const ACCESS_TYPE = &H400
Const STILL_ACTIVE = &H103
' Open the program
TaskID = Shell(strFilename, 1)
hProc = OpenProcess(ACCESS_TYPE, False, TaskID)
If Err <> 0 Then
Debug.Print "Cannot start " & strFilename, vbCritical, "Error"
Exit Function
End If
' Wait until program is closed
Do
GetExitCodeProcess hProc, lExitCode
DoEvents
Loop While lExitCode = STILL_ACTIVE
' Return the program's exit code
RunProgram = lExitCode
End Function
(Excel VBA 2007). I'm getting an error in code generated by a macro - Excel wrote the code, so why won't it run?
Some background:
Within my VBA application, I am trying to copy a worksheet with a formatted pivot table and paste it into a new workbook, keeping the formatting, but not links to the source data. A simple 'Paste' includes the source data. A 'Paste Special' with values and then formats doesn't bring across PivotTable formats.
I found a post http://blog.contextures.com/archives/2010/09/22/copy-pivot-table-format-and-values/ which explains how to manually do this - paste in from the Clipboard. This works when done manually.
I recorded a macro and it generated the following code:
Sub PivotCopyPaste()
'
' PivotCopyPaste Macro
'
' Aim: Open a workbook with a pivot table report on the first sheet.
' Create a new workbook and paste the pivot table in, without
' pivot source data, but keeping pivot formatting
Workbooks.Open Filename:="\\MyServer\MyFolder\PivotReport.xls"
Cells.Select
Selection.Copy
Workbooks.Add
Cells.Select
'I think the line below forces the paste from the Clipboard
Application.CutCopyMode = False
ActiveSheet.Paste 'ERRORS on this line
End Sub
When I run this 'as is', I get an error: "Run-Time Error 1004: Paste method of Worksheet class failed" on the ActiveSheet.Paste line.
If I take out the Application.CutCopyMode = False line, the macro runs, but it pastes in the Source Data (i.e. it's still an active PivotTable) - not what I want.
I have found lots of references to this error - including http://www.mrexcel.com/forum/excel-questions/387000-runtime-error-1004-a.html.
They suggest the clipboard may be empty. I have the clipboard pane visible in Excel and it shows something is there.
They suggest putting explicit references to the old and new sheets/ranges so that they can be referenced by variable rather than relying on the correct one being 'Active' - I tried that and it didn't make much difference (just changed the text of the error message to " Method 'Paste' of object '_Worksheet' failed".
Is it possible to do what I am trying to do? If so, how? All help gratefully received.
{Follow-up: on the same blog, Debra provides some code to paste in the data/formats for a pivot table: I can't paste the link here - not enough reputation yet - but I've included the link in my comment to #Rory below.
This allows me to paste each pivot table individually, but there are other elements on each report, different each time, such as company logo, (optionally) hidden rows containing the pivot table filters, Titles etc. I was really after a 'paste everything on the sheet' solution to make my code simple! }
I haven't done a lot of testing but try this - it should just paste whatever was copied, including pictures, but leaves pivot tables as a static range with formatting:
Private Declare Function OpenClipboard Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function CloseClipboard Lib "user32.dll" () As Long
Private Declare Function EnumClipboardFormats Lib "user32" (ByVal wFormat As Long) As Long
Private Declare Function GetClipboardFormatName Lib "user32" Alias "GetClipboardFormatNameA" ( _
ByVal wFormat As Long, ByVal lpString As String, _
ByVal nMaxCount As Long) As Long
Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare Function GetClipboardData Lib "user32.dll" (ByVal wFormat As Long) As Long
Private Declare Function GlobalLock Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Function lstrlen Lib "kernel32.dll" Alias "lstrlenA" ( _
ByVal lpString As Long) As Long
Private Declare Function lstrcpy Lib "kernel32.dll" ( _
ByVal lpStr1 As Any, ByVal lpStr2 As Any) As Long
Sub PasteAsLocalFormula()
'If the clipbaord contains an Excel range, any formula is pasted unchanged, moving sheet and _
cell references to the destination workbook.
Dim S As String
Dim i As Long, CF_Format As Long
Dim SaveDisplayAlerts As Boolean, SaveScreenUpdating As Boolean
Dim HTMLInClipBoard As Boolean
Dim Handle As Long, Ptr As Long, FileName As String
'Enumerate the clipboard formats
If OpenClipboard(0) Then
CF_Format = EnumClipboardFormats(0&)
Do While CF_Format <> 0
S = String(255, vbNullChar)
i = GetClipboardFormatName(CF_Format, S, 255)
S = Left(S, i)
HTMLInClipBoard = InStr(1, S, "HTML Format", vbTextCompare) > 0
If HTMLInClipBoard Then
Handle = GetClipboardData(CF_Format)
Ptr = GlobalLock(Handle)
Application.CutCopyMode = False
S = Space$(lstrlen(ByVal Ptr))
lstrcpy S, ByVal Ptr
GlobalUnlock Ptr
SetClipboardData CF_Format, Handle
ActiveSheet.PasteSpecial Format:="HTML"
Exit Do
End If
CF_Format = EnumClipboardFormats(CF_Format)
Loop
CloseClipboard
End If
End Sub
Adding this here as it's the first StackOverflow link served up by Google for the error "Paste method of worksheet class failed".
It seems that this error can occur when Excel isn't ready to paste. I had the error occur sporadically when copying one of a set of logo images by VBA from a hidden sheet into the main sheet. In the end I found that my code seems a lot more robust after adding a
Do While Not Application.Ready: Sleep 10: Loop immediately before the .Copy and also between the subsequent .Select and .Paste. This required placing
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) up at the top of the module, of course. I also have a DoEvents after the .Copy (following an earlier suggestion I'd found somewhere), and that seems to help too. I haven't seen the error since, FWIW :)
UPDATE - I still had errors from time to time, so I resorted to error trapping along the lines of the following. The TryLogoAgain: label goes before the earlier .Copy (not shown) because it seems to be the .Copy that has failed to work, leaving the .Paste to fail (retrying just the .Paste over and over again never worked).
On Error Resume Next
Worksheets(1).Paste Destination:=Worksheets(1).Range("B1")
If Err.Number <> 0 Then Err.Clear: MsgBox "Excel is struggling to copy something, trying again...": Sleep (10): GoTo TryLogoAgain
So far it has always managed to work on the second try! (Excel 2010 btw)
I've been spending the last few hours trying to figure out how to save a file onto the computer using VBA. The code template below that I found on another forum seems promising, except when I go to the desktop to access it, the .csv file has what looks like the page's source code instead of the actual file I want. This may be because when I go to the URL, it doesn't automatically download the file; rather, I am asked to save the file to a certain location (since I don't know the path name of the uploaded file on the site).
Is there any way to alter this code to accommodate this, or will I have to use a different code entirely?
Sub Test()
Dim FileNum As Long
Dim FileData() As Byte
Dim MyFile As String
Dim WHTTP As Object
On Error Resume Next
Set WHTTP = CreateObject("WinHTTP.WinHTTPrequest.5")
If Err.Number <> 0 Then
Set WHTTP = CreateObject("WinHTTP.WinHTTPrequest.5.1")
End If
On Error GoTo 0
MyFile = "MY_URL_HERE"
WHTTP.Open "GET", MyFile, False
WHTTP.send
FileData = WHTTP.responseBody
Set WHTTP = Nothing
If Dir("C:\Users\BLAHBLAH\Desktop", vbDirectory) = Empty Then MkDir "C:\Users\BLAHBLAH\Desktop"
FileNum = FreeFile
Open "C:\Users\BLAHBLAH\Desktop\memberdatabase.csv" For Binary Access Write As #FileNum
Put #FileNum, 1, FileData
Close #FileNum
End Sub
Cross posts:
http://www.ozgrid.com/forum/showthread.php?t=178884
http://www.excelforum.com/excel-programming-vba-macros/925352-vba-go-to-website-and-download-file-from-save-prompt.html
I found over the years more ways how to save/download data using vba:
The firs option witch I prefer and would recommend is to use the URLDownloadToFile function of the user32 library using the following solution
The second one which was also mentioned be yourself. The point here is to use the Microsoft WinHTTP Services (Interop.WinHttp) COM library. In order to achieve this you can also add the Interop.WinHttp reference to your project link. After that you are able to use simpler notation like here link
The third option I aware is to ask the browser to save it for us and then using the Save_Over_Existing_Click_Yes function was mentioned by Santosh. In this case we open an Internet Explorer using the COM interface and navigate to the proper site. So we have to add the Microsoft Internet Controls (Interop.SHDocVw) and the Microsoft HTML Object Library (Microsoft.mshtml) references to our project in order to gain intellisense feature of the editor.
I don't like this download method because this is a work around by hacking. BUT if your IE session was already established authenticated etc. this gonna work nicely. The save function of the Internet Controls was dropped because of security concern. See for example: link
Newer the less you have to have the correct url to download what you want. If you pick the wrong one you will download something else :)
So please try to make sure the the url you use is correct by enter it in a browser. If it opens the right .csv file than your source could work too.
Also please try to send some more information: for example the url to the .csv file
Try below code :
Copied from here (Not tested)
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
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
Declare Function SetForegroundWindow Lib "user32" Alias "SetForegroundWindow" (ByVal hwnd As Long) As Long
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Declare Sub Sleep Lib "kernel32" Alias "Sleep" (ByVal dwMilliseconds As Long)
Private Sub Save_Over_Existing_Click_Yes()
Dim hWnd As Long
Dim timeout As Date
Debug.Print "Save_Over_Existing_Click_Yes"
'Find the Download complete window, waiting a maximum of 30 seconds for it to appear. Timeout value is dependent on the
'size of the download, so make it longer for bigger files
timeout = Now + TimeValue("00:00:30")
Do
hWnd = FindWindow(vbNullString, "Save As")
DoEvents
Sleep 200
Loop Until hWnd Or Now > timeout
Debug.Print " Save As window "; Hex(hWnd)
If hWnd Then
'Find the child Close button
hWnd = FindWindowEx(hWnd, 0, "Button", "&Yes")
Debug.Print " Yes button "; Hex(hWnd)
End If
If hWnd Then
'Click the Close button
SetForegroundWindow (hWnd)
Sleep 600 'this sleep is required and 600 miiliseconds seems to be the minimum that works
SendMessage hWnd, BM_CLICK, 0, 0
End If
End Sub
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
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
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.
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.
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