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.
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.
Code:
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