Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations MintJulep on being selected by the Eng-Tips community for having the most helpful posts in the forums last week. Way to Go!

Save As Macro Issue

Status
Not open for further replies.
jzecha

jzecha

Aerospace
Joined
Jan 20, 2016
Messages
236
Location
US
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.

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
 
Sort by date Sort by votes
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.
 
Upvote 0 Downvote
So how would you recommend saving them with a Macro so I dont have this problem?
 
Upvote 0 Downvote
Replace "for 1..count" loop with backwards iterator:

X=sel.Count
Do while x > 0
...
X=X-1
Loop
 
Upvote 0 Downvote
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?
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

reutov_tv
  • Locked
  • Question Question
ChangeName macro issue
Replies
4
Views
547
reutov_tv
reutov_tv
M
  • Locked
  • Question Question
Bounding Box macro
Replies
1
Views
2K
ferdo
ferdo
P
  • Question Question
How Can Delete Product Description With Macro
Replies
2
Views
2K
Proportions
P
A
  • Question Question
CATIA Macro to give Overall Dimensions to a View
Replies
3
Views
839
ferdo
ferdo
Pspboy17
  • Locked
  • Question Question
CATVBA Save issue when Periods are in filename
Replies
1
Views
286
Pspboy17
Pspboy17

Part and Inventory Search

Sponsor

Back
Top