Hi, please add the option to filter out duplicated items in a Store Query and it sub collection/s content, when moving (drag-drop) an item into a sub collection. Even after refreshing/updating the Store Query (the parent one).
For example, in the image, 02.mp4 and 04.mp4 should not be in the New Stored Query, since there are already in the sub Collection collection.
For work around, I finally success created a VB script for that (on a custom Button):
Option Explicit
' ExcludeFromStoredQuery_CmdBased_V32
' (c) 2025 gt / Adapted by AI Assistant
' Uses Copy COLLREMOVE (without QUIET). Leaves tabs open.
Function OnInit(initData)
initData.name = "ExcludeFromStoredQuery_CmdBased_V32"
initData.version = "5.4"
initData.copyright = "(c) 2025 gt / AI Assistant"
initData.desc = "Removes items from Stored Query using Copy COLLREMOVE (No QUIET)"
initData.default_enable = true
initData.min_version = "12.0" ' Copy COLLREMOVE exists
End Function
Function OnClick(clickData)
DOpus.ClearOutput
' --- Configuration ---
Dim storedQueryName : storedQueryName = "New Stored Query" ' Target query
Dim collectionName : collectionName = "New Collection 020250408045427" ' Child collection name
Dim loadDelay : loadDelay = 1200 ' Milliseconds delay
' --- End Configuration ---
Dim func : Set func = clickData.Func
Dim cmd : Set cmd = func.Command
Dim sourceTab : Set sourceTab = func.SourceTab
Dim destTab : Set destTab = Nothing
DOpus.Output "Starting removal process (V32 - Copy COLLREMOVE No QUIET)..."
' --- Step 1: Ensure Source Tab is the correct Stored Query ---
Dim queryPath : queryPath = "coll://" & storedQueryName
DOpus.Output "Checking initial source tab path. Expected: " & queryPath
If sourceTab Is Nothing Then DOpus.Output "Error: Could not get source tab.", True : Exit Function
If LCase(sourceTab.path) <> LCase(queryPath) Then
DOpus.Output "Source tab is not the target query. Navigating source tab to: " & queryPath
cmd.Clear : cmd.SetSourceTab sourceTab : cmd.RunCommand "Go PATH=""" & queryPath & """"
DOpus.Output "Waiting " & loadDelay & "ms for source tab navigation..." : DOpus.Delay loadDelay
Set sourceTab = func.SourceTab ' Re-acquire
DOpus.Output "Re-acquired source tab. Verifying path again..."
If sourceTab Is Nothing Then DOpus.Output "Error: Could not re-acquire source tab after navigation.", True : Exit Function
If LCase(sourceTab.path) <> LCase(queryPath) Then
DOpus.Output "Error: Source tab path (" & sourceTab.path & ") is still not correct after attempting navigation.", True : Exit Function
End If
DOpus.Output "Source tab navigation successful. Path: " & sourceTab.path
Else
DOpus.Output "Source tab is already correct: " & sourceTab.path
End If
' --- Construct the FULL hierarchical path to the child collection ---
Dim collectionPath : collectionPath = "coll://" & storedQueryName & "/" & collectionName
' --- Step 2: Open child Collection in Destination Tab ---
DOpus.Output "Opening child collection '" & collectionPath & "' in destination..."
cmd.Clear : cmd.SetSourceTab sourceTab : cmd.RunCommand "Go PATH=""" & collectionPath & """ OPENINDUAL=quiet"
DOpus.Delay loadDelay
On Error Resume Next : Set destTab = func.DestTab : On Error GoTo 0
If destTab Is Nothing Then DOpus.Output "Error: Could not get destination tab object after opening collection.", True : Exit Function
DOpus.Output "Destination tab identified. Path: " & destTab.path
If InStr(1, destTab.path, collectionName, vbTextCompare) = 0 Then DOpus.Output "Warning: Destination tab path '" & destTab.path & "' does not seem to contain '" & collectionName & "'. Proceeding cautiously.", False
' --- Step 3: Read paths from Destination Tab ---
Dim collectionPaths : Set collectionPaths = CreateObject("Scripting.Dictionary") : collectionPaths.CompareMode = 1
Dim itemColl, readErrorOccurred : readErrorOccurred = False
On Error Resume Next
For Each itemColl In destTab.files
If Err.Number = 0 Then
If Not itemColl Is Nothing And VarType(itemColl.RealPath) = 8 Then
Dim collPathClean : collPathClean = Trim(itemColl.RealPath)
If collPathClean <> "" Then If Not collectionPaths.Exists(collPathClean) Then collectionPaths.Add collPathClean, True
End If
Else DOpus.Output " [Collection] Warning: Error reading item. Error: " & Err.Description, False : readErrorOccurred = True : Err.Clear
End If
Next
On Error GoTo 0
DOpus.Output "Found " & collectionPaths.Count & " unique items in the child collection."
' --- Step 4: *** DO NOT CLOSE THE DESTINATION TAB *** ---
DOpus.Output "Destination tab '" & destTab.path & "' will remain open."
If readErrorOccurred Then DOpus.Output "Exiting due to errors reading the child collection.", True : Exit Function
If collectionPaths.Count = 0 Then DOpus.Output "Child collection appears empty or could not be read. No items to remove.", False : Exit Function
' --- Step 5: Compare items in Source Tab ---
DOpus.Output "--- Comparing items in source query tab (" & sourceTab.path & ") ---"
Dim itemsToRemove : Set itemsToRemove = DOpus.NewVector()
Dim itemQuery, queryItemCount : queryItemCount = 0
readErrorOccurred = False
On Error Resume Next
For Each itemQuery In sourceTab.files
queryItemCount = queryItemCount + 1
If Err.Number = 0 Then
If Not itemQuery Is Nothing And VarType(itemQuery.RealPath) = 8 Then
Dim queryPathClean : queryPathClean = Trim(itemQuery.RealPath)
If queryPathClean <> "" Then If collectionPaths.Exists(queryPathClean) Then itemsToRemove.push_back itemQuery
End If
Else DOpus.Output " [Query] Warning: Error reading item #" & queryItemCount & ". Error: " & Err.Description, False : readErrorOccurred = True : Err.Clear
End If
Next
On Error GoTo 0
DOpus.Output "--- Comparison finished ---" : DOpus.Output "Checked " & queryItemCount & " items." : DOpus.Output "Found " & itemsToRemove.count & " item(s) to remove."
If readErrorOccurred Then DOpus.Output "Exiting due to errors reading the source query tab.", True : Exit Function
' --- Step 6: Select and REMOVE items from Source Tab using Copy COLLREMOVE ---
If itemsToRemove.count > 0 Then
DOpus.Output "Selecting items in source Stored Query tab..."
cmd.Clear : cmd.SetSourceTab sourceTab : cmd.ClearFiles : cmd.AddFiles itemsToRemove
cmd.RunCommand "Select FROMSCRIPT SET"
DOpus.Delay 200
DOpus.Output "Running Copy COLLREMOVE command on source tab (NO QUIET)..."
cmd.Clear
cmd.SetSourceTab sourceTab ' Ensure command context is the query tab
' *** USE Copy COLLREMOVE FROMSEL (No QUIET) ***
' Dim removeCmd : removeCmd = "Copy COLLREMOVE """ & Replace(storedQueryName, """", """""") & """ FROMSEL" ' Removed QUIET
Dim removeCmd : removeCmd = "Delete REMOVECOLLECTION" ' Removed QUIET
DOpus.Output "Executing: " & removeCmd ' Log the exact command
cmd.RunCommand removeCmd
DOpus.Output itemsToRemove.count & " item(s) should have been removed from the active stored query list."
Else
DOpus.Output "No items found in the source query that match the child collection."
End If
' --- Step 7: Do NOT close the source tab ---
DOpus.Output "Finished. Source tab '" & sourceTab.path & "' and Dest tab '" & destTab.path & "' remain open."
End Function
' Helper function to get the active tab (same as V20-V31)
Function GetActiveTab(tabType, expectedPath)
Dim lister, tab, i, j
On Error Resume Next : Set tab = Nothing : Set lister = DOpus.ActiveLister
If Not lister Is Nothing Then Set tab = lister.ActiveTab
If Not tab Is Nothing Then If LCase(tab.path) = LCase(expectedPath) Then Set GetActiveTab = tab : Exit Function
For i = 0 To DOpus.Listers.count - 1 : Set lister = DOpus.Listers(i)
For j = 0 To lister.tabs.count - 1 : Set tab = lister.tabs(j)
If Not tab Is Nothing Then If LCase(tab.path) = LCase(expectedPath) Then Set GetActiveTab = tab : Exit Function
Next
Next
DOpus.Output "GetActiveTab: Could not find tab with path: " & expectedPath, True : Set GetActiveTab = Nothing : On Error GoTo 0
End Function
thank you in advanced.
