从PowerPoint VBA提取OLEObject（XML文档） [英] Extracting an OLEObject (XML Document) from PowerPoint VBA
问题描述
此应用程序的一部分将元数据存储在XML文档中，以便我们可以检索后续元数据，并重新填充或更新从用户形式创建的图形。只要我们依赖本地驱动器上存在的XML文件，这样做不错，这不是一个理想的解决方案。我们更喜欢将XML（不链接）嵌入到PPTM文件中，我已经能够做到（见附件）。
问题是我找不到一种方法来获取VBA来成功提取OLEObject XML文件。
OLEObject可以从PPT手动打开（mouseclick / etc ），它可以罚款。但是，当我们尝试以编程方式提取此文档并将其保存到驱动器，以便VBA可以将文件路径传递到COM对象时，生成的提取的XML文件总是显示已损坏。
我找到的唯一方法是：
metaDoc.Copy
CreateObject（Shell.Application）。命名空间（ActivePresentation.Path）.self.InvokeVerb粘贴
我已经看到有一些困难与OLEFormat.ProgID =包，可能不允许所需的行为。
我有一些解决方法，像创建PPTM文件的ZIP副本和提取从该文件夹的嵌入式文档XML文件应该可以工作，但是如果有一个更简单的方法来激活此形状/对象并通过VBA与其进行交互，这将非常有用。
这是一些创建XML并将其插入的示例代码。问题是我如何提取它，或者我必须执行上面提到的ZIP方法？
Public Const XMLFileName As String = XML Embedded File.xml
Sub ExampleCreateEmbedXML（）
Dim fso As Object
Dim oFile As Object
Dim metaDoc As Shape
Dim shp As Shape
Dim sld As Slide
Dim user As String
Dim xmlExists As Boolean
xmlExists = False
user = Environ（Username）
XMLFilePath =C：\Users\&用户& \& xmlExists = True
如果
下一个
如果不是xmlExists Then
'如果XML OLEObject不存在，则创建一个：
'创建一个新的文件在活动的工作簿的路径
设置fso = CreateObject（Scripting.FileSystemObject）
设置oFile = fso.CreateTextFile（XMLFilePath）
oFile.Close
'然后将新的xml文档嵌入相应的幻灯片
设置metaDoc = sld.Shapes.AddOLEObject（FileName：= XMLFilePath _
，Link：= False，DisplayAsIcon：= False）
metaDoc。 Name = XMLFileName
'将其保存到驱动器，以便可以由COM对象访问：
metaDoc.Copy
CreateObject（Shell.Application）。Namespace（ ActivePresentation.Path）.self.InvokeVerb粘贴
'此文件将是一个空的XML文件，不会解析，但即使是由COM对象正确创建的
'的文件（针对嵌入文件与提取的文件进行了验证）
'无法正常打开。似乎这种粘贴对象的方法在
'xml结构中产生错误。
'我通过激活Metadoc对象进行比较，该对象在任何XML查看器
'中呈现罚款，但保存的下拉版本不会打开，并且在txt编辑器中查看时显然损坏
否则：
'该文件存在，所以在这一点上，COM对象将读取
'并对文档进行处理，或允许用户通过
'userform界面来操作图形连接到数据库
'COM对象然后保存XML文件
'然后另一个子例程将重新插入XML文件。
'这部分不是问题，它正在让VBA打开并读取OLEObject，这是
'证明是困难的。
如果
End Sub
经过大量的搜索之后，当我偶然发现一个可能的解决方案时，我已经写下了这个，并且正在转向几个计划B解决方案之一。
我知道 DoVerbs 1 激活嵌入的包文件（.txt，.xml等），但是我没有任何控制通过记事本的新实例，我需要读取其中包含的XML。
而不是复制并尝试粘贴对象（手动和编程失败）
'将其保存到驱动器，以便可以通过COM对象访问：
metaDoc.Copy
CreateObject（Shell.Application）。Namespace（ActivePresentation.Path）.self.InvokeVerb粘贴
我能够使用这里发布的一个稍微修改版本的解决方案：
读取作为字符串的开放的未保存的记事本实例，然后我写入一个新的文件。这是从上述链接中记录的 NotepadFunctions.ReadNotepad（）函数调用的。
code> Sub ExtractLocalXMLFile（xlsFile As Object）
'提取嵌入的包对象（例如TXT文件）
'从记事本实例读取字符串内容，
'打印一个新的来自嵌入文件的带有内容的文件。
Dim embedSlide As slide
Dim DataObj As New MSForms.DataObject'这是剪贴板内容/对象的容器
Dim fullXMLString As String'这是从剪贴板捕获的字符串。
Dim t As Long'Timer variable
MsgBox导航到隐藏的幻灯片，因为只有当& _
幻灯片处于活动状态。
设置embedSlide = ActivePresentation.Slides（隐藏）
ActivePresentation.Windows（1）.View.GotoSlide embedSlide.SlideIndex
'Make确定没有其他副本存在于temp dir中：
On Error Resume Next
Kill UserName& \AppData\Local\Temp\& _
MetaDataXML_FilePath
'用txt替换xls扩展名
错误GoTo 0
xlsFile.OLEFormat.DoVerb 1
'1打开XML包对象 - - '为xls / xlsm文件使用动词2打开。
'在这种情况下，我可以控制Notepad.exe
t =定时器+ 1
尽管Timer& t
'等待...当文件打开
Wend
'检索嵌入文件的内容
fullXMLString = Notepad_Functions.ReadNotepad（ Notepad_Functions.FindNotepad（Chart Meta XML）
'此函数关闭记事本（将使其成为一个子例程，而不是
'CloseAPP_BNOTEPAD.EXE'< ; ---这个函数没有记录在我的示例中StackOverflow
'创建一个新的文本文件
WriteOutTextFile fullXMLString，MetaDataXML_FilePath
'获取删除嵌入文件
xlsFile.Delete
End Sub
Sub WriteOutTextFile（fileString As String，filePath As String）
'在filePath
'中创建一个txt文件从temp包/ XML对象插入内容（filestring）
Dim oFile As Object
Dim fso As Object
设置fso = CreateObject（Scripting.FileSystemObject）
设置oFile = fso.CreateTextFile（filePath）
oFile.WriteLine（fileString）
oFile.Close
End Sub
I am developing an application in VBA. Userforms connect to a COM object that reads an SPSS Statistics SAV file or an SPSS Dimensions MDD file.
Part of this application stores metadata in an XML document so that we can retrieve the metadata later and repopulate or update the graphics created from the userforms. This works fine as long as we rely on an XML file existing on a local drive - which is not a desirable solution. We would prefer to embed (not link) the XML in to the PPTM file, which I have been able to do (see attached).
The problem is that I can't find a way to get VBA to extract the OLEObject XML File successfully.
The OLEObject can be opened from PPT manually (mouseclick/etc) and it renders fine. But when we try to programmatically extract this document and save it to a drive so that VBA can pass the file path to the COM object, the resulting extracted XML file always appears corrupted.
The only method I have found is:
metaDoc.Copy
CreateObject("Shell.Application").Namespace(ActivePresentation.Path).self.InvokeVerb "Paste"
I have read that there is some difficulty with OLEFormat.ProgID = "Package" which may not allow for the desired behavior.
I have some workarounds in mind, like creating a ZIP copy of the PPTM file and extracting the embedded document XML file from that folder, which should work, but if there is an easier way to Activate this shape/object and interact with it via VBA, that would be extremely helpful.
Here is some example code that creates the XML and inserts it. The question is how do I extract it, or must I do the ZIP method mentioned above?
Public Const XMLFileName As String = "XML Embedded File.xml"
Sub ExampleCreateEmbedXML()
Dim fso As Object
Dim oFile As Object
Dim metaDoc As Shape
Dim shp As Shape
Dim sld As Slide
Dim user As String
Dim xmlExists As Boolean
xmlExists = False
user = Environ("Username")
XMLFilePath = "C:\Users\" & user & "\" & XMLFileName
Set sld = ActivePresentation.Slides(1)
For Each shp In sld.Shapes
If shp.Name = XMLFileName Then
xmlExists = True
End If
Next
If Not xmlExists Then
'If the XML OLEObject doesn't exist, then create one:
'Create a new file in the active workbook's path
Set fso = CreateObject("Scripting.FileSystemObject")
Set oFile = fso.CreateTextFile(XMLFilePath)
oFile.Close
'And then embed the new xml document into the appropriate slide
Set metaDoc = sld.Shapes.AddOLEObject(FileName:=XMLFilePath _
, Link:=False, DisplayAsIcon:=False)
metaDoc.Name = XMLFileName
'Save this out to a drive so it can be accessed by a COM Object:
metaDoc.Copy
CreateObject("Shell.Application").Namespace(ActivePresentation.Path).self.InvokeVerb "Paste"
'This file will be an empty XML file which will not parse, but even files that have been
' created correctly by the COM object (verified against the embed file vs. the extracted file)
' do not open properly. It seems that this method of pasting the object yields errors in
' xml structure.
' I have compared by activating the Metadoc object which renders fine in any XML viewer
' but the saved down version does not open and is obviously broken when viewed in txt editor
Else:
'The file exists, so at this point the COM object would read it
' and do stuff to the document or allow user to manipulate graphics through
' userform interfaces which connect to a database
' the COM object then saves the XML file
' another subroutine will then re-insert the XML File.
' this part is not a problem, it's getting VBA to open and read the OLEObject which is
' proving to be difficult.
End If
End Sub
After a lot (a LOT) of searching, I had written this off and was moving on to one of several "Plan B" solutions, when I stumbled on a possible solution.
I know that DoVerbs 1 activates the embedded package file (.txt, .xml, etc) but I did not have any control over the new instance of Notepad, from which I need to read the XML contained therein.
Instead of copying and trying to paste the object (which fails manually and programmatically)
'Save this out to a drive so it can be accessed by a COM Object:
metaDoc.Copy
CreateObject("Shell.Application").Namespace(ActivePresentation.Path).self.InvokeVerb "Paste"
I was able to use a slightly modified version of the solution posted here:
to read the open, unsaved instance of Notepad as a string, which I then write to a new file. This is called from the NotepadFunctions.ReadNotepad() function documented in the above mentioned link.
Sub ExtractLocalXMLFile(xlsFile As Object)
'Extracts an embedded package object (TXT file, for example)
' reads string contents in from Notepad instance and
' prints a new file with string contents from embed file.
Dim embedSlide As slide
Dim DataObj As New MSForms.DataObject 'This is the container for clipboard contents/object
Dim fullXMLString As String 'This is the captured string from clipboard.
Dim t As Long 'Timer variable
MsgBox "Navigating to the hidden slide because objects can only be activated when " & _
"the slide is active."
Set embedSlide = ActivePresentation.Slides("Hidden")
ActivePresentation.Windows(1).View.GotoSlide embedSlide.SlideIndex
'Make sure no other copies of this exist in temp dir:
On Error Resume Next
Kill UserName & "\AppData\Local\Temp\" & _
MetaDataXML_FilePath
'replace an xls extension with txt
On Error GoTo 0
xlsFile.OLEFormat.DoVerb 1
'1 opens XML package object -- ' for xls/xlsm files use Verb 2 to Open.
' in which case I can maybe control Notepad.exe
t = Timer + 1
Do While Timer < t
'Wait... while the file is opening
Wend
'Retrieve the contents of the embedded file
fullXMLString = Notepad_Functions.ReadNotepad(Notepad_Functions.FindNotepad("Chart Meta XML"))
'This function closes Notepad (would make it a subroutine, instead.
'CloseAPP_B "NOTEPAD.EXE" '<--- this function is NOT documented in my example on StackOverflow
'Create a new text file
WriteOutTextFile fullXMLString, MetaDataXML_FilePath
'Get rid of the embedded file
xlsFile.Delete
End Sub
Sub WriteOutTextFile(fileString As String, filePath As String)
'Creates a txt file at filePath
'inserting contents (filestring) from the temp package/XML object
Dim oFile As Object
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set oFile = fso.CreateTextFile(filePath)
oFile.WriteLine (fileString)
oFile.Close
End Sub
这篇关于从PowerPoint VBA提取OLEObject（XML文档）的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
