-1

MS Project 2007 で VBA を使用して、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>

ここに私の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

助けていただければ幸いです。

4

1 に答える 1

5

XPathについて知っていますか？あなたのコードの痛みを伴う見た目から、あなたはそうしません。野蛮なDOMメソッドの長い組み合わせを使用して必要なノードにアクセスする代わりに、多くの苦痛を軽減し、XPathを使用して1行でノードにアクセスする必要があります。

私があなたがやろうとしていることを正しく理解しているなら、次のようなものがあなたのダブルループ全体をから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

ここで、「引用符」内のものはXPathです。お役に立てれば。

ProjectFileNameちなみに、XMLファイルにまったく同じ情報を含む属性とFileName要素があると、非効率的で混乱しやすく、エラーが発生しやすくなります。どうしたの？

于 2011-03-31T22:09:37.767 に答える