Save As Macro Issue

[jzecha]

I have written the Macro shown below and have ran into an issue I can't figure out.

When I run the Macro and change the save location to a new folder, it saves all the parts and products to the new folder exactly like I need.
But during this, it saves some of the parts in the old location,overwriting them, before saving them to the new location.

I need to modify my code in a way to prevent it from ever saving over the original location files if I have specified a new directory.

Sub CATMain()

Dim noSymPartName As String
Dim noSymProductName As String
Dim newCharacter As String
newCharacter = "_"

CATIA.DisplayFileAlerts = False

Set oDocs = CATIA.Documents
docPath = oDocs.Item(1).Path
changePath = MsgBox("Current save location is: " & vbNewLine  & vbNewLine & docPath & vbNewLine  & vbNewLine & " Would you like to change file path?", vbYesNo, "Current Save Location")

If changePath = vbYes Then

Const WINDOW_HANDLE = 0
Const NO_OPTIONS = &H0001
'Const File_Path = "\\GTFS1\Share\Data\"
Const File_Path = 17
Set objShell = CreateObject("Shell.Application") 

'Set objFolder = objShell.BrowseForFolder _
' (WINDOW_HANDLE, "Select a folder:", NO_OPTIONS, docPath) 

Set objFolder = objShell.BrowseForFolder _
(WINDOW_HANDLE, "Select a folder:", NO_OPTIONS, File_Path)

Set objFolderItem = objFolder.Self 
'objPath = objFolderItem.Path
docPath = objFolderItem.Path

    If MsgBox("This is the new location the open product will save:" & vbNewLine & vbNewLine & docPath & vbNewLine & vbNewLine & "Is this the correct location?", vbYesNo, "Save Location") = vbNo Then
MsgBox "Pick a New  Save Location",, "Changing Save Location"

Set objShell = CreateObject("Shell.Application") 

Set objFolder = objShell.BrowseForFolder _
(WINDOW_HANDLE, "Select a folder:", NO_OPTIONS, File_Path)

Set objFolderItem = objFolder.Self 
docPath = objFolderItem.Path
    End If

'Else
' If changePath = vbNo Then
'docPath = docPath

'Set objFolderItem = CreateObject("Scripting.FileSystemObject")

'docPath = InputBox("Enter new file path", "File path")

End If

CATIA.RefreshDisplay = False

'Search Assembly For Parts/Products
Dim sel As Selection
Set sel = CATIA.ActiveDocument.Selection
sel.Search "CATAsmSearch.Product,all"
For X = 1 To sel.Count

'Checking To See If Current Item X is a Product
If Right(sel.Item(X).LeafProduct.ReferenceProduct.Parent.Name, 7) = "Product" Then

Set oDoc1 = sel.Item(X).LeafProduct.ReferenceProduct.Parent
Set oProduct1 = oDoc1.Product

'For x = 1 To oDocs.Count

'If TypeName(oDocs.Item(x)) = "ProductDocument" Then
'Set oDoc1 = oDocs.Item(x)
'Set oProduct1 = oDoc1.Product

    noSymProductName = oProduct1.PartNumber 'get the current PartNumber

	noSymProductName = Replace(noSymProductName,".","")
	noSymProductName = Replace(noSymProductName,",","")
	noSymProductName = Replace(noSymProductName,"(","")
	noSymProductName = Replace(noSymProductName,")","")
	noSymProductName = Replace(noSymProductName,"/","")
	noSymProductName = Replace(noSymProductName,"\","")
	noSymProductName = Replace(noSymProductName,"#","")
	noSymProductName = Replace(noSymProductName,"$","")
	noSymProductName = Replace(noSymProductName,"%","")
	noSymProductName = Replace(noSymProductName,"*","")


oDoc1.SaveAs docPath & "\" & noSymProductName & ".CATProduct"
End If


If Right(sel.Item(X).LeafProduct.ReferenceProduct.Parent.Name, 4) = "Part" Then
Set oDoc2 = sel.Item(X).LeafProduct.ReferenceProduct.Parent
Set oPart1 = oDoc2.Product

'Next 'x

'For v = 1 To oDocs.Count

'If TypeName(oDocs.Item(v)) = "PartDocument" Then
'Set oDoc2 = oDocs.Item(v)
'Set oPart1 = oDoc2.Product


    noSymPartName = oPart1.PartNumber 'get the current PartNumber

	noSymPartName = Replace(noSymPartName,".","")
	noSymPartName = Replace(noSymPartName,",","")
	noSymPartName = Replace(noSymPartName,"(","")
	noSymPartName = Replace(noSymPartName,")","")
	noSymPartName = Replace(noSymPartName,"/","")
	noSymPartName = Replace(noSymPartName,"\","")
	noSymPartName = Replace(noSymPartName,"#","")
	noSymPartName = Replace(noSymPartName,"$","")
	noSymPartName = Replace(noSymPartName,"%","")
	noSymPartName = Replace(noSymPartName,"*","")


oDoc2.SaveAs docPath & "\" & noSymPartName & ".CATPart"

'On Error Resume Next
End If
Next 'x
'Next 'v


CATIA.RefreshDisplay = True

Msgbox "Save Finished!",,"SAVE FINISH!" 

Msgbox "YOU HAVE TO USE SAVE MANAGEMENT NOW!",,"YOU HAVE TO USE SAVE MANAGEMENT NOW!" 

End Sub

 

[Little Cthulhu]

This is how "Save As" command works, isnt't it? If so, don't expect it's behaviour to be different in macro.

I guess you have to start from the bottom (leaf) components of your assembly.

 

[jzecha]

So how would you recommend saving them with a Macro so I dont have this problem?

 

[LWolf]

use the send-to functionality?

https://www.eng-tips.com/viewthread.cfm?qid=326907

regards,
LWolf

 

[Little Cthulhu]

Replace "for 1..count" loop with backwards iterator:

X=sel.Count
Do while x > 0
...
X=X-1
Loop

 

[jzecha]

I tried both of your recommendations.

LWolf,

After doing enough research to setup my Macro correctly for Send To, I get an error that the method "SetInitialFile" failed, and from my googling, I think its because I do not have the PX1 license, so i can't run Send To through a Macro.


Little Cthulhu,
This took awhile, since I had never even seen the "Do While" command, which i must say is pretty cool.
But this still leaves two products being saved in the original location before they are Saved in their new location, which overwrites files I do not want to overwrite.

Any more advice?