'#Reference {F64FEA84-AF63-11D0-81CE-444553540000}#1.0#0#SUCCESSDB.DLL#US Cost SuccessDB Object Library v1.0
Sub Main()
'
'
' DetailItemAssignments_DeleteZeroQuantities
'
' This macro will delete any Detail Item Assignments from the active tree of 
' the active project, that contain a zero quantity.
'
' Version 1.0 (9-23-1999)
'
' Copyright (C)1990-1999 By U.S. COST, Inc.
'
' Permission to use, copy, modify, and distribute this software for any purposes
' without fee is hereby granted, provided that the above copyright notice appears
' in all copies and that both the copyright notice and the limited warranty and
' restricted rights notice below appear in all supporting documentation.
'
' U.S. COST PROVIDES THIS PROGRAM "AS-IS" AND WITH ALL FAULTS. U.S. COST, INC.
' DISCLAIMS ANY IMPLIED WARRANTY OF MERCHANTIBILITY OR FITNESS FOR A PARTICULAR USE.
' U.S. COST, INC. DOES NOT WARRANT THAT THE OPERATION OF THE PROGRAM WILL BE
' UNINTERRUPTED OR ERROR FREE.
'
'
On Error GoTo ErrorHandler

Dim objSuccessApp As Object
Dim objDocument As Object
Dim objProject As Object
Dim objTree As Object
Dim lngSelectedTree As Long

    Set objSuccessApp = CreateObject("Success.Application.1")
    
    If objSuccessApp.Documents.Count > 0 Then
    
   	 	Set objDocument = objSuccessApp.ActiveDocument
    	Set objProject = objDocument.Project

        lngSelectedTree = objDocument.SelectedTree
   
        Set objTree = objProject.Trees(lngSelectedTree - 1)

    	RemoveZeroQuantityAssignments objTree.TreeLevels
    
    	objDocument.Refresh

    	MsgBox "All zero quantity detail item assignments have been removed.",,"Delete Zero Quantity Detail Item Assignments"
    
    Else
    
    	MsgBox "A project must be opened.",,"Error"	
    
    End If
    
    Set objSuccessApp = Nothing
    Set objDocument = Nothing
    Set objTree = Nothing
    Set objProject = Nothing

Exit Sub

ErrorHandler:
    
    If Err.Number = 440 Then
        
        MsgBox "An OLE Automation error occurred.",, "Error"
        
    Else
        
        MsgBox Err.Number + 28765 & ": " & Err.Description,, "Error"
        
    End If

    Set objSuccessApp = Nothing
    Set objDocument = Nothing
    Set objProject = Nothing
    Set objTree = Nothing

End Sub

Sub RemoveZeroQuantityAssignments(objInLevels As Object)
Dim objInLevel As Object
Dim objDetailItemAssignments As Object
Dim objDetailItemAssignment As Object
Dim intDetailCount As Integer
Dim intLevelCount As Integer
Dim intDetail As Integer
Dim intLevel As Integer

    intLevelCount = objInLevels.Count
    
    If intLevelCount > 0 Then
    
        For intLevel = intLevelCount - 1 To 0 Step -1
        
            Set objInLevel = objInLevels(intLevel)
            
            Set objDetailItemAssignments = objInLevel.DetailItemAssignments
                
            intDetailCount = objDetailItemAssignments.Count
                
            If intDetailCount > 0 Then
                    
                For intDetail = intDetailCount - 1 To 0 Step -1
                    
                    Set objDetailItemAssignment = objDetailItemAssignments(intDetail)
                        
                    If objDetailItemAssignment.Quantity = 0 Then
                        
                       objDetailItemAssignments.Remove objDetailItemAssignment
                       DoEvents
                    
                    End If
                
                Next intDetail
            
            End If
                
            RemoveZeroQuantityAssignments objInLevel.TreeLevels
            
        Next intLevel
    
    End If
    
    Set objInLevel = Nothing
    Set objDetailItemAssignment = Nothing
    Set objDetailItemAssignments = Nothing

End Sub