Replace Part Number with Dictionary Keys for Errors Issue

[jzecha]

I have the following VBA Code the lets me replace a specified string in a Part Number with a different String.
It works great, except when there are conflicting name issues.

So I incorporated Err.Number and Dictionary Feature.
Which worked great, but I would like at the end of the code to show the Msgbox with all the Parts that had errors.
The commented out section at the bottom of the code does this except it pops up multiple times because I am unable to figure out how to end the Product Counting.

If somebody could give me some pointers, it would be greatly appreciated.

Sub CatMAIN()
  Set actProd = CATIA.ActiveDocument.Product
  origstr = InputBox("Enter any name or number to be replaced!!! ", "Test")
  Select Case True
  Case StrPtr(origstr) = 0
  Exit Sub
  End Select
  
  newstr = InputBox("Enter the name or the number with which they are to be replaced", "Test")
  Select Case True
  Case StrPtr(newstr) = 0
  Exit Sub
  End Select

  traverse actProd, origstr, newstr
End Sub

Sub traverse(Prod, origstr, newstr)

Dim DictionaryReplacePartNumber
Set DictionaryReplacePartNumber = CreateObject("scripting.dictionary")

CATIA.RefreshDisplay = False

If Prod.Products.Count > 0 Then
For i = 1 To Prod.Products.Count
Call traverse(Prod.Products.Item(i), origstr, newstr)
  
  On Error Resume Next
   
  
    Set refp = Prod.Products.Item(i).ReferenceProduct
    
    'Checks to See if new string has already been applied to Part Number
    If InStr(refp.Name, newstr) Then
    'Do Nothing
    Else
        If InStr(refp.Name, origstr) Then
        newpname = Replace(refp.Name, origstr, newstr)
        refp.Name = newpname
        
            If Err.Number <> 0 Then
                If DictionaryReplacePartNumber.exists(refp.Name) = False Then
                DictionaryReplacePartNumber.Add refp.Name, aPart
                MsgBox "There is already a Part/Product with the Name: " & refp.Name
                Else
                'Do Nothing
                End If
            End If
        
        End If
    End If
  
    'Checks to See if new string has already been applied to Product Number
    If InStr(refp.PartNumber, newstr) Then
    'Do Nothing
    Else
        If InStr(refp.PartNumber, origstr) Then
        newpnum = Replace(refp.PartNumber, origstr, newstr)
        refp.PartNumber = newpnum
        
            If Err.Number <> 0 Then
                If DictionaryReplacePartNumber.exists(refp.PartNumber) = False Then
                DictionaryReplacePartNumber.Add refp.PartNumber, aPart
                MsgBox "There is already a Part/Product with the Name: " & refp.PartNumber
                Else
                'Do Nothing
                End If
            End If

        End If
    End If
         
    Next
  End If
  
  CATIA.RefreshDisplay = True
  
 ' Call LoggedErrors(DictionaryReplacePartNumber)
  
  End Sub

'Sub LoggedErrors(DictionaryReplacePartNumber)
  
'If DictionaryReplacePartNumber.Count = 1 Then

'MsgBox "There Is " & DictionaryReplacePartNumber.Count & " Detail That Was Unable " & vbCrLf & _
'"To Have Their Part Number Replaced:" & vbCrLf & vbCrLf & _
'Join(DictionaryReplacePartNumber.keys, vbCrLf)

'ElseIf DictionaryReplacePartNumber.Count > 1 Then

'MsgBox "There Are " & DictionaryReplacePartNumber.Count & " Different Details That Were Unable" & vbCrLf & _
'"To Have Their Part Number Replaced:" & vbCrLf & vbCrLf & _
'Join(DictionaryReplacePartNumber.keys, vbCrLf)

'Else

'MsgBox "All Details Have Had Their Part Numbers Replaced."

'End If

'End Sub

 

[LWolf]

so, why don't you put the LoggedErrors call in CATMain. The dictionary needs to be declared there as well and passed in along with other stuff into the traverse function. alternatively you declare it as public above the CATMain. Right now you are calling the Traverse sub many times, and as such your LoggedErrors routine gets called just as many times

regards,
LWolf

 

[jzecha]

Thanks for the advice, I knew it would be something simple.

Works perfectly now!

Here is the Updated Code:

Sub CatMAIN()
  Set actProd = CATIA.ActiveDocument.Product
  origstr = InputBox("Enter any name or number to be replaced!!! ", "Test")
  Select Case True
  Case StrPtr(origstr) = 0
  Exit Sub
  End Select
  
  newstr = InputBox("Enter the name or the number with which they are to be replaced", "Test")
  Select Case True
  Case StrPtr(newstr) = 0
  Exit Sub
  End Select

  Dim DictionaryReplacePartNumber
  Set DictionaryReplacePartNumber = CreateObject("scripting.dictionary")

  traverse actProd, origstr, newstr, DictionaryReplacePartNumber
  
  Call LoggedErrors(DictionaryReplacePartNumber)
   
End Sub

Sub traverse(Prod, origstr, newstr, DictionaryReplacePartNumber)

CATIA.RefreshDisplay = False

If Prod.Products.Count > 0 Then
For i = 1 To Prod.Products.Count
Call traverse(Prod.Products.Item(i), origstr, newstr, DictionaryReplacePartNumber)

  'Set refp = Prod.ReferenceProduct
  
  On Error Resume Next
  
    Set refp = Prod.Products.Item(i).ReferenceProduct
    
    'Checks to See if new string has already been applied to Part Number
    If InStr(refp.Name, newstr) Then
    'Do Nothing
    Else
        If InStr(refp.Name, origstr) Then
        newpname = Replace(refp.Name, origstr, newstr)
        refp.Name = newpname
        
            If Err.Number <> 0 Then
                If DictionaryReplacePartNumber.exists(refp.Name) = False Then
                DictionaryReplacePartNumber.Add refp.Name, aPart
                'MsgBox "There is already a Part/Product with the Name: " & refp.Name
                Else
                'Do Nothing
                End If
            End If
        
        End If
    End If
  
    'Checks to See if new string has already been applied to Product Number
    If InStr(refp.PartNumber, newstr) Then
    'Do Nothing
    Else
        If InStr(refp.PartNumber, origstr) Then
        newpnum = Replace(refp.PartNumber, origstr, newstr)
        refp.PartNumber = newpnum
        
            If Err.Number <> 0 Then
                If DictionaryReplacePartNumber.exists(refp.PartNumber) = False Then
                DictionaryReplacePartNumber.Add refp.PartNumber, aPart
                MsgBox "There is already a Part/Product with the Name: " & refp.PartNumber
                Else
                'Do Nothing
                End If
            End If

        End If
    End If
     
    Next
  End If
  
  CATIA.RefreshDisplay = True
    
End Sub

Sub LoggedErrors(DictionaryReplacePartNumber)
  
If DictionaryReplacePartNumber.Count = 1 Then

MsgBox "There Is " & DictionaryReplacePartNumber.Count & " Detail That Was Unable " & vbCrLf & _
"To Have Their Part Number Replaced:" & vbCrLf & vbCrLf & _
Join(DictionaryReplacePartNumber.keys, vbCrLf)

ElseIf DictionaryReplacePartNumber.Count > 1 Then

MsgBox "There Are " & DictionaryReplacePartNumber.Count & " Different Details That Were Unable" & vbCrLf & _
"To Have Their Part Number Replaced:" & vbCrLf & vbCrLf & _
Join(DictionaryReplacePartNumber.keys, vbCrLf)

Else

MsgBox "All Details Have Had Their Part Numbers Replaced."

End If

End Sub