VBA: Copy all files in the Active document to a new location

[Anonymous]

I am trying to create a VBA macro to copy al of the files referenced in the active document to a new location.

Some similar Apprentice examples use the Inventor.FileSaveAs to collect all of the references before executing the save as but I cannot get it to work.

Here is my code limited to just the current document for testing purposes:

it fails at:   Call oFileSaveAs.AddFileToSave(oDoc, sTargetFile)

  - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

   ' Set references to active document, Target Directory, Filename.
   Dim oDoc As Inventor.Document
   Set oDoc = ThisApplication.ActiveDocument
  
   Dim sFullFileName As String
   sFullFileName = oDoc.FullFileName

   Dim sFilename As String
   sFilename = Right(sFullFileName, Len(sFullFileName) - InStrRev(sFullFileName, "\"))
  
   ' Set Target Directory & Filename
   Dim sTargetDir As String
   sTargetDir = "C:\Test\"

Dim sTargetFile As String
   sTargetFile = sTargetDir & sFilename

' Set a reference to the FileSaveAs object.
   Dim oFileSaveAs As Inventor.fileSaveAs
   Call oFileSaveAs.AddFileToSave(oDoc, sTargetFile)
   Call oFileSaveAs.ExecuteSave

 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

Any help would be appreciated.

Alasdair

References used:

http://forums.autodesk.com/t5/inventor-customization/copy-assembly-similar-to-pack-and-go/m-p/265181...

http://www.mcadforums.com/forums/viewtopic.php?f=15&t=12087&p=84255&hilit=filesaveas#p84255

SDK sample: C:\Users\Public\Documents\Autodesk\Inventor 2013\SDK\UserTools\CopyDesign\Source\form1.vb

[Anonymous · Accepted solution]

I have resolved this issue, for anyone that needs to do something similar here is the final code.

Public Sub Copy()

   ' Set references to active document, Target Directory, Filename.
   Dim oDoc As Inventor.Document
   Set oDoc = ThisApplication.ActiveDocument
   
   Dim sFullFileName As String
   sFullFileName = oDoc.FullFileName

   Dim sFilename As String
   sFilename = Right(sFullFileName, Len(sFullFileName) - InStrRev(sFullFileName, "\"))
        
   ' Set Target Directory & Filename
   Dim sTargetDir As String
   sTargetDir = "C:\Temp\"

   Dim sTargetFile As String
   sTargetFile = sTargetDir & sFilename
   'Check to see if the file is already in the target directory
   If sFullFileName = sTargetFile Then GoTo FileExists

   ' Copy the Active Document
   Call oDoc.SaveAs(sTargetFile, True)

   ' Get all of the documents referenced by the active document.
   Dim allRefDocs As Inventor.Documents

   ' Dim oRefDoc As Inventor.Document
   For Each oRefDoc In oDoc.AllReferencedDocuments
   
   ' Get the full filename of the current document.
   Dim sRefFullFilename As String
   sRefFullFilename = oRefDoc.FullFileName
   
   Dim sRefFilename As String
   sRefFilename = Right(sRefFullFilename, Len(sRefFullFilename) - InStrRev(sRefFullFilename, "\"))

   Dim sRefTargetFile As String
   sRefTargetFile = sTargetDir & sRefFilename

   ' Copy the Reference Documents, check if they exist already
   If Dir(sRefTargetFile) = "" Then
   Call oRefDoc.SaveAs(sRefTargetFile, True)
   End If
Next

   ' Close Current Document & Open New document
   Call oDoc.Close
   
   Dim oNewDoc As Inventor.Document
   Set oNewDoc = ThisApplication.Documents.Open(sTargetFile)

   'ZoomAll
   ThisApplication.ActiveView.Fit True

GoTo Finished

FileExists:
MsgBox "Your file is already in C:\Temp..."

Finished:

End Sub

[Anonymous]

Can you write a code which can copy the flat pattern view (if present) from all drawings(.idw) in a folder into one common development drawing?

[Anonymous]

Hi alasdair,

I have found your code to be useful but i would like to modify it a little and need some help.

I changed the string srefFileName to:

sRefFilename = "1130" & Right(sRefFullFilename, 17)

This saves the reference files in this format successfully.But inside the part file the iproperty as well as model browser name does not change according to the file name.

Is there a way i can incorportate the change in this code itself so that the iproperty name becomes same as the filename?

I would be grateful for your help.

Thanks,

Sid

using Inventor 2011

[Anonymous]

Hi Sid,

I have not tried to update iProperties from the filename but this should be possible.

To get the filename without extension you can use:

   ' Get Filename
    Dim sFullPathFilename As String
    Dim sFullFileName As String
    Dim sFilename As String
    sFullPathFilename = FullFileName
    sFullFileName = Right(sFullPathFilename, Len(sFullPathFilename) - InStrRev(sFullPathFilename, "\"))
    sFilename = Left(sFullFileName, Len(sFullFileName) - 4)

Also see:

http://modthemachine.typepad.com/my_weblog/2010/05/working-with-filenames.html

Then set the property you want to sFilename with something like this:

 ' Get the design tracking property set.
 Dim invDesignInfo As PropertySet
 Set invDesignInfo = invDoc.PropertySets.Item("Design Tracking Properties")

'Set the Part number to filename
 Dim invProjectProperty As Property
 Set invProjectProperty = invDesignInfo("Part Number")
 invProjectProperty.Value = "sFilename"

More Info: http://download.autodesk.com/us/community/mfg/Part_2.pdf

I hope that helps.

Alasdair

[fakeru]

The code works good, except when trying to copy frame generator assemblies. It cannot save the skeleton.ipt part. It says it must be saved together with frame.iam.

Any solutions to this?

Regards

Alexandru

[Anonymous]

Hi Alexandru,

You could try a different approach if it doesn't work for Frame Generator asemblies.

1. List all files in the Active Document
2. Copy them using VBA instead of Save As
3. Close the current Document
4. Open the copied Document

Here is some code for listing all of the files in the active docuemnt

Dim oDoc As Document
Dim Refs As String
Refs = ThisApplication.ActiveDocument.FullDocumentName & vbCrLf
Set oDoc = ThisApplication.ActiveDocument
For i = 1 To oDoc.AllReferencedDocuments.count
Refs = Refs & oDoc.AllReferencedDocuments.Item(i).FullDocumentName & vbCrLf
Next 

[amarcoc]

Hi.

Loved this code!

I only want to copy files in workspace folder, and avoid library files.

Any way to keep folder hierarchy as in Workspace?

Thanks!