从 MS Project VBA 中的 XML 文件中删除节点 [英] Remove a node from XML file in MS Project VBA

问题描述

我想使用 MS Project 2007 中的 VBA 从我的 xml 文件中删除一个节点.

I’d like to remove a node from my xml file using VBA in MS Project 2007.

应该很简单，但我无法运行.

Should be so easy but I can’t get it running.

这是我的 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>

这是我的 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

我很乐意得到帮助！

推荐答案

你知道 XPath?从您的代码痛苦的外观来看，您没有.与其使用一长串野蛮的 DOM 方法组合来访问您需要的节点，您应该省去很多麻烦，只需使用 XPath 一行即可访问它.

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.

如果我正确理解您要执行的操作，那么类似以下内容可以替换您的整个双循环，从 i=0 到 Next ProjectFileList:

If I understand correctly what you're trying to do, then something like the following can replace your entire double loop, from i=0 to 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

引号"中的内容是 XPath.希望这会有所帮助.

where the thing in "quotes" is an XPath. Hope this helps.

作为旁注，在您的 XML 文件中拥有一个包含完全相同信息的 ProjectFileName 属性和一个 FileName 元素似乎是低效、混乱且容易出错的.这是怎么回事?

As a side note, it seems inefficient, confusing, and error-prone to have a ProjectFileName attribute and a FileName element containing the exact same information in your XML file. What's up with that?

这篇关于从 MS Project VBA 中的 XML 文件中删除节点的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！