从 MS Project VBA 中的 XML 文件中删除节点
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/5506548/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Remove a node from XML file in MS Project VBA
提问by BBQ Chef
I'd like to remove a node from my xml file using VBA in MS Project 2007.
我想在 MS Project 2007 中使用VBA从我的 xml 文件中删除一个节点。
Should be so easy but I can't get it running.
应该很容易，但我无法让它运行。
Here is my XML
这是我的 XML
<config id="config" ConfigSaveDate="2011-03-31 21:32:55" ConfigSchemaVersion="1.02">
<Custom>
</Custom>
<Program>
<DateFormat>yyyy-mm-dd hh:mm:ss</DateFormat>
</Program>
<ProjectFile ProjectFileName="projectfile1.mpp">
<RevisionNumber>201</RevisionNumber>
<FileName>projectfile1.mpp</FileName>
<LastSaveDate>2011-03-23 16:45:19</LastSaveDate>
</ProjectFile>
<ProjectFile ProjectFileName="projectfile2bedeleted.mpp">
<RevisionNumber>115</RevisionNumber>
<FileName>projectfile2bedeleted.mpp</FileName>
<LastSaveDate>2011-03-31 21:12:55</LastSaveDate>
</ProjectFile>
<ProjectFile ProjectFileName="projectfile2.mpp">
<RevisionNumber>315</RevisionNumber>
<FileName>projectfile2.mpp</FileName>
<LastSaveDate>2011-03-31 21:32:55</LastSaveDate>
</ProjectFile>
</config>
Here is my VBA code
这是我的 VBA 代码
Function configProjListDelete(configPath As String, ProjFiles As Variant) As Integer
' This function shall delete <ProjectFile> tags from the config.xml
' and shall delete coresponding project xml files from HD
' It shall return number of deleted files
' configPath is the path to the xml folder
' ProjFiles is an array of file names of to be deleted files in above mentioned folder
Dim xml As MSXML2.DOMDocument
Dim RootElem As MSXML2.IXMLDOMElement
'Dim cxp1 As CustomXMLPart
Dim delNode As MSXML2.IXMLDOMNode ' XmlNode 'MSXML2.IXMLDOMElement
Dim fSuccess As Boolean
Dim ProjectFileList As MSXML2.IXMLDOMElement
Dim fn As Variant 'file name in loop
Dim i As Integer
Dim delCnt As Integer
If Not FileExists(configPath) Then
' given configFile doesn't exist return nothing
Debug.Print " iven config file doesn't exist. File: " & configPath
GoTo ExitconfigProjListDelete
End If
'TODO: Catch empty ProjectFiles
' Initialize variables
Set xml = New MSXML2.DOMDocument
On Error GoTo HandleErr
' Load the XML from disk, without validating it.
' Wait for the load to finish before proceeding.
xml.async = False
xml.validateOnParse = False
fSuccess = xml.Load(configPath)
On Error GoTo 0
' If anything went wrong, quit now.
If Not fSuccess Then
GoTo ExitconfigProjListDelete
End If
Set RootElem = xml.DocumentElement
Debug.Print "- " & xml.getElementsByTagName("ProjectFile").Length & " ProjectFiles in config."
i = 0
delCnt = 0
' Loop through all ProjectFiles
For Each ProjectFileList In xml.getElementsByTagName("ProjectFile")
' check if each project file name is one of the files to be deleted
For Each fn In ProjFiles
If fn = ProjectFileList.getElementsByTagName("FileName").NextNode.nodeTypedValue Then
Debug.Print fn & " shall be deleted"
' remove it from the document
' here I'm struggeling!
'#################################################
' How to delete the node <ProjectFile> and its childNodes?
Set delNode = ProjectFileList.ParentNode
xml.DocumentElement.RemoveChild (ProjectFileList) ' Error: 438 rough translation: "Object doesn't support this methode"
' This is all I've tried, but nothing works
'===========================================
'RootElem.RemoveChild (delNode)
'xml.RemoveChild (delNode)
'RootElem.RemoveChild (ProjectFileList.SelectSingleNode("ProjectFile"))
'ProjectFileList.ParentNode.RemoveChild (ProjectFileList.ChildNodes(0))
'Set objParent = datenode.ParentNode
'xmldoc.DocumentElement.RemoveChild (objParent)
'Set ProjectFileList = Empty
delCnt = delCnt + 1
End If
Next fn
i = i + 1
Next ProjectFileList
' Save XML File
If checkAppPath("Trying to update config file.") Then
xml.Save CustomProperty("XMTMLMonitoring_AppPath") & "\" & m2w_config("SubFolder") & "\" & m2w_config("SubFolderData") & "\" & m2w_config("XMLConfigFileName")
Debug.Print " - Config has been updated and saved."
Else
MsgBox "Config data not exported to web." & Chr(10) & "Folder: '" & CustomProperty("XMTMLMonitoring_AppPath") & "\" & m2w_config("SubFolder") & "\" & m2w_config("SubFolderData") & Chr(10) & "doesn't exist. ", vbOKOnly, HEADLINE
End If
Set xml = Nothing
configProjListDelete = delCnt
ExitconfigProjListDelete:
Exit Function
HandleErr:
Debug.Print "XML File reading error " & Err.Number & ": " & Err.DESCRIPTION
MsgBox "Error " & Err.Number & ": " & Err.DESCRIPTION
On Error GoTo 0
End Function
I'd be glad to get some help!
我很乐意得到一些帮助！
回答by Jean-Fran?ois Corbett
Do you know about XPath? From the painful looks of your code, you do not. Instead of using a long combination of barbaric DOM methods to access the node you need, you should save yourself a lot of pain and just use an XPath to access it in one line.
你知道XPath吗？从您的代码痛苦的外观来看，您没有。与其使用一长串野蛮的 DOM 方法组合来访问您需要的节点，您应该省去很多麻烦，只需使用 XPath 一行即可访问它。
If I understand correctly what you're trying to do, then something like the following can replace your entire double loop, from i=0to Next ProjectFileList:
如果我正确理解您要执行的操作，那么类似以下内容可以替换您的整个双循环，从i=0到Next ProjectFileList：
For i = LBound(ProjFiles) To UBound(ProjFiles)
Set deleteMe = XML.selectSingleNode( _
"/config/ProjectFile[@ProjectFileName='" & ProjFiles(i) & "']")
Set oldChild = deleteMe.parentNode.removeChild(deleteMe)
Next i
where the thing in "quotes" is an XPath. Hope this helps.
“引号”中的内容是 XPath。希望这可以帮助。
As a side note, it seems inefficient, confusing, and error-prone to have a ProjectFileNameattribute and a FileNameelement containing the exact same information in your XML file. What's up with that?
附带说明一下，在 XML 文件中拥有包含完全相同信息的ProjectFileName属性和FileName元素似乎效率低下、令人困惑且容易出错。那是怎么回事？
