I have written an Outlook-VSTO-Add-In in VB to solve the issue that in Quick search results, Outlook does not tell you in which folder a found item lives.
My Add-In adds two items to the explorer's context menu:
Name of containing folder to display the name of the parent folder of the selected item
Goto containing folder to change the current folder to the selected item's parent folder
This works all as desired.
Now, I'd like to extend the functionality of 2. so that when Outlook changes to the item's parent folder the item is automatically selected.
myOutlook.ActiveExplorer.AddToSelection(mailItem) should do the thing, but unfortunately the adding operation fails; the selection count myOutlook.ActiveExplorer.Selection.Count is not changed. Any help would be much appreciated.
My environment:
Windows 10
Outlook für Office 365 MSO (16.0.12527.21296) 64 Bit
Microsoft Visual Studio Community 2019, Version 16.8.3
Full project (as *.sln) is available on GitHub here
Code extract:
Public Sub GetButtonID(control As Office.IRibbonControl)
Dim myOutlook As Outlook.Application = Globals.ThisAddIn.Application
System.Diagnostics.Debug.WriteLine("Count: " & CStr(myOutlook.ActiveExplorer.Selection.Count))
If myOutlook.ActiveExplorer.Selection.Count > 0 Then
Dim mailItem As Outlook.MailItem
mailItem = DirectCast(myOutlook.ActiveExplorer.Selection(1), Outlook.MailItem)
Select Case control.Id
Case "FolderDisplay"
Dim messageBoxText As String = "The item is in folder:" & vbLf & vbLf _
& DirectCast(mailItem.Parent, Outlook.Folder).FolderPath
MsgBox(messageBoxText, 0, "In which folder?")
Case "FolderGoto"
System.Diagnostics.Debug.WriteLine("Current: " & TryCast(myOutlook.ActiveExplorer.CurrentFolder.Name, String) _
& myOutlook.ActiveExplorer.Selection.Count) ' yields <1>
' Change the current folder:
myOutlook.ActiveExplorer.CurrentFolder = DirectCast(mailItem.Parent, Outlook.Folder)
System.Diagnostics.Debug.WriteLine("Current: " & TryCast(myOutlook.ActiveExplorer.CurrentFolder.Name, String) _
& myOutlook.ActiveExplorer.Selection.Count) ' yields <0>
System.Windows.Forms.Application.DoEvents() ' needed, otherwise the mailItem will not be selectable
' Additionally, set the initial mailItem as selected:
' But this doesn't work for unknown reasons.
' .AddToSelection() does not work for unknown reasons.
If myOutlook.ActiveExplorer.IsItemSelectableInView(mailItem) Then
' https://social.msdn.microsoft.com/Forums/en-US/aedcbda9-5304-4969-82ac-dbd41e0879b0/select-item-in-activeexplorer?forum=outlookdev
System.Diagnostics.Debug.WriteLine("Selectable!")
System.Diagnostics.Debug.WriteLine("Adding0: " & myOutlook.ActiveExplorer.Selection.Count) ' <0> is OK
System.Diagnostics.Debug.WriteLine(CStr("Item: " & mailItem.Subject)) ' verify, that the element is the desired one
myOutlook.ActiveExplorer.AddToSelection(mailItem) ' This FAILS !
System.Diagnostics.Debug.WriteLine("Adding1: " & myOutlook.ActiveExplorer.Selection.Count) ' should be <1> but is still <0> :-(
System.Windows.Forms.Application.DoEvents() ' thought in vain that this would help
System.Diagnostics.Debug.WriteLine("Adding2: " & myOutlook.ActiveExplorer.Selection.Count) ' should be <1> but is still <0> :-(
System.Diagnostics.Debug.WriteLine("Which Folder? = " & myOutlook.ActiveExplorer.CurrentFolder.Name)
Else
System.Diagnostics.Debug.WriteLine("Not selectable!")
End If
End Select
End If
End Sub
Related
I would like to do an Advanced Search of messages for multiple words without having to do each one manually/separately.
If I could record a macro in Outlook 2016, which as I understand it I cannot do, these are the commands I would do:
Record Macro
Click on Search Current Mailbox.
Click on Search Tools.
Click Advanced Search.
For the drop-down after “In:” choose “frequently-used text fields”.
Type into “Search for the word(s):” the text to find.
(Entering multiple words there means to find one string of all the words, not to find each word individually.)
Click Find Now.
Stop recording macro.
Edit the VBA code produced to:
Specify the rest of the words to find
Specify case-insensitive
Then do the Find Now.
Then I would like to display them all.
Preferably sorted, but not necessary if will make it more complicated code.
From piecing together code found online, I have the code below.
Subject is the only value I can use debug.print on. The others give errors:
"Run-time error '5': Invalid procedure call or argument".
I only know how to search on Subject.
I do not know how to display the list of what I have found (not in Immediate window).
' Test VBA for Multiple-Word Search in Outlook - 3
Sub TestSearchForMultipleFolders()
Dim Scope As String
Dim Filter As String
Dim MySearch As Outlook.Search
Dim MyTable As Outlook.Table
Dim nextRow As Outlook.Row
m_SearchComplete = False
'Establish scope folder
Scope = "'" & Application.Session.GetDefaultFolder(olFolderInbox).FolderPath & "'"
Debug.Print Scope
'Establish filter
If Application.Session.DefaultStore.IsInstantSearchEnabled Then
Filter = Chr(34) & "urn:schemas:httpmail:subject" & Chr(34) & " ci_phrasematch 'Office'"
Debug.Print Filter
Filter = Chr(34) & "urn:schemas:httpmail:subject" & Chr(34) & " ci_phrasematch 'rent'" _
& " OR ""urn:schemas:httpmail:subject" & Chr(34) & " ci_phrasematch 'breaking'"
'(subject:invoice OR body:invoice) AND hasattachments:yes NOT from:Amazon
Else
Filter = Chr(34) & "urn:schemas:httpmail:subject" & Chr(34) & " like '%Office%'"
End If
Debug.Print Filter
Set MySearch = Application.AdvancedSearch(Scope, Filter, True, "MySearch")
'While m_SearchComplete <> True
' DoEvents
'Wend
Set MyTable = MySearch.GetTable
Do Until MyTable.EndOfTable
Set nextRow = MyTable.GetNextRow()
'Debug.Print nextRow("SentOnBehalfOf")
' Debug.Print nextRow("From")
' Debug.Print nextRow("ReceivedTime")
Debug.Print nextRow("Subject")
Loop
End Sub
Outlook doesn't provide a macro recorder like Word or Excel. You need to create a VBA macro manually in Outlook.
The Advanced search in Outlook programmatically: C#, VB.NET article explains how to use the AdvancedSearch method in Outlook.
The Outlook Object Model also provides the AdvancedSearchStopped event. The signatures of the AdvancedSearchStopped and AdvanvedSearchComplete event handlers are the same. The AdvancedSearchStopped event is triggered when the Stop method is called on the Search object to cancel searching. However, the AdvancedSearchComplete is called afterwards anyway.
Admittedly, the Search class allows you to save the results of searching in a search folder (actually, it doesn’t contain any items, only references to items from the scope folders). You just need to call the Save method on the Search object in the AdvanvedSearchComplete event handler.
For example, in VBA you can define the AdvanvedSearchComplete event handler in the following way:
Public m_SearchComplete As Boolean
Private Sub Application_AdvancedSearchComplete(ByVal SearchObject As Search)
If SearchObject.Tag = "MySearch" Then
m_SearchComplete = True
End If
End Sub
MS Word 2010 has a bug in its ability to correctly maintain (of all things) the documents collection (link to earliest report found - social.msdn.microsoft.com).
As far as I can tell this bug only impacts Word 2010. Although the documents collection is not maintained, it turns out that the Application.Windows collection is. Hence, for Word 2010 the following code based on the original reporters investigation (see below) and this question on answers.microsoft.com seem to provide a good alternative to the buggy documents collection:
' PURPOSE:
' Return a document collection, work-around for Word 2010 bug
Public Function docCollection() As VBA.Collection
Dim indexOfAvailableAppWindows As Long
Dim resultDoc As VBA.Collection
Dim foundDoc As Word.Document
Set resultDoc = New Collection
For indexOfAvailableAppWindows = 1 To Application.Windows.Count
If Application.Windows(indexOfAvailableAppWindows).Document.Type = wdTypeDocument Then
Set foundDoc = Application.Windows(indexOfAvailableAppWindows).Document
resultDoc.Add foundDoc, foundDoc.FullName ' Can NOT use 'name' - fails to be unique
End If
Next indexOfAvailableAppWindows
Set docCollection = resultDoc
Set resultDoc = Nothing
End Function
However, and here's my question, the above code some times fails with error 457 This key is already associated with an element of this collection on line resultDoc.Add foundDoc, foundDoc.FullName. What circumstances could possibly lead to such a failure?
So far the code has only failed on 1 PC running Word 2016. I don't have access to the PC. I did discover that the original version used Document.Name as the key (which was not always unique, so this was changed to Document.Full name)
Assumptions:
Document.FullName will always be unique
Things I've ruled out:
use of Split Window
opening downloaded documents (protected window documents are not counted)
Code that can be used to demonstrate the issue in Word 2010 (adapted from the original report).
' Function Credit Bas258 (https://social.msdn.microsoft.com/profile/bas258)
Function test01() As Boolean
'Adapted to VBA from original: 03-11-2012 1.0 Visual Studio 2008 VB code
Dim oDoc As Word.Document
Dim oDoc0 As Word.Document
Dim oDoc1 As Word.Document
Dim oDoc2 As Word.Document
Dim oDoc3 As Word.Document
Dim oDoc4 As Word.Document
Dim n As Integer
Set WDapp = Application
With WDapp
Debug.Print (Format(Now(), "dd-MM-yyyy") & " MS Office " & .Application.Version)
Set oDoc0 = .Documents.Add: Debug.Print ("add " & oDoc0.Name)
Set oDoc1 = .Documents.Add: Debug.Print ("add " & oDoc1.Name)
Set oDoc2 = .Documents.Add: Debug.Print ("add " & oDoc2.Name)
Set oDoc3 = .Documents.Add: Debug.Print ("add " & oDoc3.Name)
Set oDoc4 = .Documents.Add: Debug.Print ("add " & oDoc4.Name)
For n = 1 To .Documents.Count
Debug.Print ("count " & n & " " & .Documents(n).Name)
Next n
Debug.Print ("close " & oDoc4.Name)
oDoc4.Close
Set oDoc4 = Nothing
Debug.Print ("close " & oDoc3.Name)
oDoc3.Close
Set oDoc3 = Nothing
For n = 1 To .Documents.Count
Debug.Print ("count " & n & " " & .Documents(n).Name)
Next n
n = 0
For Each oDoc In .Documents
n = n + 1
Debug.Print ("doc " & n & " " & oDoc.Name)
Next oDoc
n = 0
For Each oWin In .Windows
n = n + 1
Debug.Print ("win " & n & " " & oWin.Document.Name)
Next oWin
Debug.Print ("close " & oDoc2.Name)
oDoc2.Close
Set oDoc2 = Nothing
Debug.Print ("close " & oDoc1.Name)
oDoc1.Close
Set oDoc1 = Nothing
Debug.Print ("close " & oDoc0.Name)
oDoc0.Close
Set oDoc0 = Nothing
End With
Set WDapp = Nothing
End Function
This is NOT going to be the accepted answer. Although it does answer the broader question (what could cause this code to crash) it not address the specific crash that I am trying to isolate. Either way there appears to be another bug in MS Word which seemed to be worth capturing for the common good.
This time the bug is with the Windows Collection; and joy of joys, I've confirmed it for both Word 2010 and Word 2016 - both 64 bit apps.
Steps to reproduce the bug are as follows:
In windows explorer enable the Preview Pane
Select a word document FILE so that it is 'previewed'
Open the same document (without losing the 'preview view')
Run the code from the OP, it will crash on this line:
If Application.Windows(indexOfAvailableAppWindows).Document.Type = wdTypeDocument Then
It turns out that when a word file is being previewed the Application.Windows.Count property is incremented by the preview; however any attempt to get a property of that window results in Error 5097 - Word has encountered a problem.
So, an improvement to the original code would therefore be:
' PURPOSE:
' Returns a healthy document collection
' - work-around for Word 2010 bug
' - excludes hits from Windows Explorer Preview Pane
Public Function docCollection() As VBA.Collection
On Error GoTo docCollectionError
Dim indexOfAvailableAppWindows As Long
Dim resultDoc As VBA.Collection
Dim foundDoc As Word.Document
Set resultDoc = New Collection
' Use index instead of Each to avoid For Loop Not initialised error, preview pane
For indexOfAvailableAppWindows = 1 To Application.Windows.Count
If Application.Windows(indexOfAvailableAppWindows).Document.Type = wdTypeDocument Then
Set foundDoc = Application.Windows(indexOfAvailableAppWindows).Document
resultDoc.Add foundDoc, foundDoc.FullName ' Key must NOT be 'name' - fails to be unique see BUG: 1315
End If
lblSkipThisDoc:
Next indexOfAvailableAppWindows
Set docCollection = resultDoc
Set resultDoc = Nothing
Exit:
Exit Function
docCollectionError:
If Err.Number = 5097 Then ' An open document is also open in the Windows Explorer Preview Pane
Err.Clear
Resume lblSkipThisDoc ' - skip this window
End If
If Err.Number = 457 Then ' Key is already used, but HOW? Unknown cause of error
Err.Clear
Stop 'Resume lblSkipThisDoc ' Is it safe to skip this document, why is there a duplicate?
End If
End Function
There is a setting in MS Word that enables 1 document to be viewed in 2 windows. In Word 2010 it is under the View (Tab): Window > New Window
The new window is counted separately in Application.Windows.Count and returns the same document object, hence the key exists.
For indexOfAvailableAppWindows = 1 To Application.Windows.Count ' <<< New Windows is counted
If Application.Windows(indexOfAvailableAppWindows).Document.Type = wdTypeDocument Then
Set foundDoc = Application.Windows(indexOfAvailableAppWindows).Document
resultDoc.Add foundDoc, foundDoc.FullName ' <<< fails to add 2nd instance of document
End If
So... the solution would likely involve checking the caption of the document:
IMMEDIATE WINDOW:
?foundDoc.Windows(1).Caption
Document2:1
I recently converted (exported/imported) a 2007 Access file to 2010. Everything works fine except one form. I keep getting the error:
Compile error: User-defined type not defined
I tried adding "Microsoft ActiveX Data Objects 2.8" to my References, but the problem still exists. Sub ClearTreeView(tvwTree As TreeView) is what Access highlighted as the issue.
Option Compare Database
Option Explicit
' Clears all nodes on a treeview control
Sub ClearTreeView(tvwTree As TreeView) 'what Access highlighted as the issue
On Error GoTo EH
tvwTree.Nodes.Clear
Exit Sub
EH:
MsgBox "Error " & Err.Number & ": " & Err.Description
End Sub
' Calls functions to clear and populate a treeview control
' Parameters:
' strForm Name of the form
' strTV TreeView control name
' strSourceName Name of the table or query containing the data used to populate the treeview
' strChildField ID field for the child records
' strParentField Parent ID Field
' strTextField Field containing text that will be used as node labels
'
Sub FillTreeView(tvwTree As Object, strSourceName As String, strChildField As String, strParentField As String, strTextField As String)
Dim strSQL As String
Dim rs As DAO.Recordset
On Error GoTo EH
' Open the recordset using table and fields specified in Sub parameters
strSQL = "SELECT " & strChildField & ", " & strParentField & ", " & strTextField & " FROM " & strSourceName
Set rs = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)
' Clear any existing data out of the treeview
ClearTreeView tvwTree
' Call recursive function to fill in treeview
AddTreeData tvwTree, rs, strChildField, strParentField, strTextField
' Close the recordset
rs.Close
Set rs = Nothing
Exit Sub
EH:
MsgBox "Error " & Err.Number & ": " & Err.Description
End Sub
' Recursive function to populate a treeview control
' Parameters:
' strFormName Name of the form
' strTreeViewName TreeView control name
' rs Recordset containing the data used to populate the treeview
' strChildField ID field for the child records
' strParentField Parent ID Field
' strTextField Field containing text that will be used as node labels
' varParentID Optional parameter that only gets passed for recursive calls to this function. Specifies the ID of the current record to be used as a
' ParentID when searching the recordset for "grand-children", etc.
Sub AddTreeData(objTV As TreeView, rs As DAO.Recordset, strChildField As String, strParentField As String, strTextField As String, Optional varParentID As Variant)
Dim nodChild As Node
Dim nodParent As Node
Dim strLabel As String
Dim strNodeID As String
Dim strCriteria As String
Dim strBookmark As String
On Error GoTo EH
' Test for a circular reference
If rs(strChildField) = rs(strParentField) Then GoTo EH_CircularReference
' If the optional parameter is missing, then this is the first(non-recursive) call to this function.
' Set the critieria to look for a parent id of 0.
If IsMissing(varParentID) Then
strCriteria = strParentField & " = 0 "
Else
' Otherwise, extract the childID portion of the node ID, which was passed as an optional parameter.
strCriteria = strParentField & " = " & Mid(varParentID, InStr(1, varParentID, "C") + 1)
' Define the parent node
Set nodParent = objTV.Nodes("node" & varParentID)
End If
' Look for records having the specified "parent"
rs.FindFirst strCriteria
Do Until rs.NoMatch
' Read node caption from the text field
strLabel = rs(strTextField)
' Create a new node ID in the format ParentID &"C" & ChildID (eg: 4C12)
strNodeID = "node" & rs(strParentField) & "C" & rs(strChildField)
' If optional parameter is missing (first call to this function)...
If Not IsMissing(varParentID) Then
'add new node to the next higher node for this record
Set nodChild = objTV.Nodes.Add(nodParent, tvwChild, strNodeID, strLabel)
Else
' Otherwise, add new node to the top level of the tree
Set nodChild = objTV.Nodes.Add(, , strNodeID, strLabel)
End If
' Bookmark our place in the recordset so that we can resume the search from the same point after the recursive call to this function.
strBookmark = rs.Bookmark
' call this function recursively for "children"
AddTreeData objTV, rs, strChildField, strParentField, strTextField, rs(strParentField) & "C" & rs(strChildField)
' Return to bookmared place in the recordset
rs.Bookmark = strBookmark
' Find the next record having the same parentID
rs.FindNext strCriteria
Loop
Exit Sub
EH_CircularReference:
MsgBox "Exiting because of a circular reference in which a child record was determined to be it's own parent."
Exit Sub
EH:
MsgBox "Error " & Err.Number & ": " & Err.Description
End Sub
I received the same error on one of my User Forms in Excel!
If your new 2010 Office package is 64Bit, then the previous 32-Bit ActiveX Controls used in the 2007 version will not be compatible.
Refer to this link: http://msdn.microsoft.com/en-us/library/ee691831(office.14).aspx#odc_office2010_Compatibility32bit64bit_ActiveXControlCOMAddinCompatibility
If you try opening the form in design view and the TreeView control doesn't exist on the form, then this is likely to be the issue.
To find if you installed the 64-bit version:
Open Access -> File -> Help -> and look under "About Microsoft Access" on the right - it should say 32-Bit or 64-Bit in brackets
As the link explains, you will have to replace the incompatible functionality - so you will have to use a new control.
Possible Solution:
If you open the form in design view, and select the down arrow on the Controls Group in the Ribbon Tab - there should be an option named "ActiveX Controls" (You have to be in design view to select it)
Search here for the "CTreeView" Control and try working with that instead of the traditional Microsoft TreeView Control (which shouldn't be listed on 64-Bit Access).
If you have 32-Bit office installed, then I can't figure out the problem with what you have posted - but I suspect it's the case.
Best Regards,
Is it possible to programmatically enumerate the Data Macros in an Access 2010+ database? If so, how?
Note: Data Macros are trigger-like procedures that are created in the context of the table designer UI. They were new in Acces 2010. They are NOT the same thing as normal macros, which are easy to enumerate.
They have their own new AcObjectType enumeration value : acTableDataMacro, but I can find no other aspect of the Access or DAO object model that refers to them. They do not even appear in the MSysObjects table.
This code will export DataMacro metadata to an XML Document (Source):
Sub DocumentDataMacros()
'loop through all tables with data macros
'write data macros to external files
'open folder with files when done
' click HERE
' press F5 to Run!
' Crystal
' April 2010
On Error GoTo Proc_Err
' declare variables
Dim db As DAO.Database _
, r As DAO.Recordset
Dim sPath As String _
, sPathFile As String _
, s As String
' assign variables
Set db = CurrentDb
sPath = CurrentProject.Path & "\"
s = "SELECT [Name] FROM MSysObjects WHERE Not IsNull(LvExtra) and Type =1"
Set r = db.OpenRecordset(s, dbOpenSnapshot)
' loop through all records until the end
Do While Not r.EOF
sPathFile = sPath & r!Name & "_DataMacros.xml"
'Big thanks to Wayne Phillips for figuring out how to do this!
SaveAsText acTableDataMacro, r!Name, sPathFile
'have not tested SaveAsAXL -- please share information if you do
r.MoveNext
Loop
' give user a message
MsgBox "Done documenting data macros for " & r.RecordCount & " tables ", , "Done"
Application.FollowHyperlink CurrentProject.Path
Proc_Exit:
' close and release object variables
If Not r Is Nothing Then
r.Close
Set r = Nothing
End If
Set db = Nothing
Exit Sub
Proc_Err:
MsgBox Err.Description, , _
"ERROR " & Err.Number _
& " DocumentDataMacros"
Resume Proc_Exit
Resume
End Sub
EDIT: Gord pointed out that you wanted the DataMacros opposed to standard macros. I found some code and tested it (it works) here
I tested the top function when you follow that link and it saves information regarding your table macros for each table in an XML document. It works nicely, props to whoever wrote it.
Closed. This question needs debugging details. It is not currently accepting answers.
Edit the question to include desired behavior, a specific problem or error, and the shortest code necessary to reproduce the problem. This will help others answer the question.
Closed 8 years ago.
Improve this question
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.
Here is my 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
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!
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.
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
where the thing in "quotes" is an XPath. Hope this helps.
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?