- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
VBA Saving: Change default file path and automatically click yes
I have a program that writes out a list of parts that I need from an autocad drawing and I have a part template that goes and picks up the information from there and either
1) Opens the part template and activates that document
2) checks that the parts already exist and input them into the head assembly
3) if not it saves the part to a specified file location with an unspecified name
4) then it updates the information and inputs the part into the assembly
5) reactivates the assembly
My issue is that I cannot use the file dialog. We use a program that on initial save or save as generates a sequential file number. If I use the file dialog it doesn't trigger the program that generates the part name. So I need to figure out how to target location and automatically say yes so that we aren't rerouting it to the target location every single time and just clicking ok over and over again.
Any help would be appreciated, thank you.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Sure, here's my file control functions. Right now, instead of getting the name of the new file, I have to declare the new location and have it look for the latest file. If it doesn't go to the proper location, it won't open the right file.
Something to note is that while it says to "Create from template", these aren't your typical empty file templates with just properties preset and everything. These are actually fully modeled assemblies with rules associated with them that dynamically model the assemblies based on input information.
Private Sub CreateCoverPlates_Click()
On Error GoTo ErrorHandler
'Save workbook so that assemblies are getting latest updated file
ThisWorkbook.Save
'Declare Variables
Dim Exist As Boolean
Dim Rotation As Boolean
Dim CoverPlateGap As Double
Dim Length As Double
Dim Width As Double
Dim Point(2) As Double
Dim i As Integer
Dim oRow As Integer
Dim oRow2 As Integer
Dim FileName As String
Dim JobBook As String
Dim Location As String
Dim Material As String
Dim SheetName As String
Dim PlateFile As String
Dim PlateType As String
Dim Template As String
Dim UOM As UnitsOfMeasure
Dim ListSheet As Worksheet
Dim JobSheet As Worksheet
Dim Doc As Inventor.Document
Dim InventorObjects As Variant
Dim oInventor As Inventor.Application
Dim CoverPlateDoc As PartDocument
Dim CoverPlateObjects As Variant
Dim CoverPlateInventor As Inventor.Application
'Setting up file information
FileName = "INVENTOR COVER PLATES.xlsx"
JobBook = ThisWorkbook.Name
Location = "N:\Mechpart\TLONG\Parts Lists\"
SheetName = "Sheet1"
Template = "C:\Work\Designs\Project Documents\EDH\Working Projects\Dynamic Base Assemblies\Dynamic Cover Plate.ipt"
'Opening list of created plates
Workbooks.Open FileName:=Location & FileName, ReadOnly:=True
'Windows(FileName).Visible = False
'Open new assembly file for cover plate layout
InventorObjects = FileControl.OpenInventorFile("Assembly (Imperial).iam", True)
Set oInventor = InventorObjects(0)
Set Doc = InventorObjects(1)
oInventor.ScreenUpdating = False
Set ListSheet = Workbooks(FileName).Sheets(SheetName)
Set JobSheet = Workbooks(JobBook).Worksheets("Cover Plates")
oRow = 1
'Iterate through all cover plates in the list
With JobSheet
Do While .Range("A" & oRow) <> ""
Exist = False
PlateFile = ""
'Determine Plate information
PlateType = .Range("A" & oRow)
If PlateType = "Surface" Then
CoverPlateGap = 0.75
Material = Workbooks(JobBook).Worksheets("PCR").Range("B4")
ElseIf PlateType = "Flush" Then
CoverPlateGap = 0.9375
If Workbooks(JobBook).Worksheets("PCR").Range("B5") = True Then
If Split(Workbooks(JobBook).Worksheets("PCR").Range("B4"), " ")(1) = "AL" Then
Material = "1/8 " & Split(Workbooks(JobBook).Worksheets("PCR").Range("B4"), " ")(1)
Else
Material = "12GA " & Split(Workbooks(JobBook).Worksheets("PCR").Range("B4"), " ")(1)
End If
Else
Material = Workbooks(JobBook).Worksheets("PCR").Range("B4")
End If
End If
Length = Application.WorksheetFunction.Max(.Range("B" & oRow), .Range("C" & oRow)) + 2 * CoverPlateGap
Width = Application.WorksheetFunction.Min(.Range("B" & oRow), .Range("C" & oRow)) + 2 * CoverPlateGap
Point(0) = .Range("D" & oRow) - CoverPlateGap
Point(1) = .Range("F" & oRow) - CoverPlateGap
Point(2) = 0
If Abs(.Range("E" & oRow) - .Range("D" & oRow)) < Abs(.Range("G" & oRow) - .Range("F" & oRow)) Then
Rotation = True
Else
Rotation = False
End If
'Search through the list of existing cover plates for a match
oRow2 = 1
Do While ListSheet.Range("A" & oRow2) <> ""
If ListSheet.Range("A" & oRow2) = Length And ListSheet.Range("B" & oRow2) = Width And ListSheet.Range("C" & oRow2) = Material And UCase(ListSheet.Range("D" & oRow2)) = UCase(PlateType) Then
PlateFile = ListSheet.Range("E" & oRow2)
Exist = True
Exit Do
End If
oRow2 = oRow2 + 1
Loop
If Exist = False Then
Workbooks(JobBook).Activate
CoverPlateObjects = FileControl.CreateFromTemplate("C:\Work\Designs\Project Documents\EDH\Working Projects\Dynamic Base Assemblies\Dynamic Cover Plate.ipt")
Set CoverPlateInventor = CoverPlateObjects(0)
Set CoverPlateDoc = CoverPlateObjects(1)
PlateFile = CoverPlateDoc.FullFileName
CoverPlateDoc.Activate
'Update part parameters
Set UOM = CoverPlateDoc.UnitsOfMeasure
Set oParameters = CoverPlateDoc.ComponentDefinition.Parameters
Set oLength = oParameters.Item("CutoutLength")
Set oWidth = oParameters.Item("CutoutWidth")
Set oMaterial = oParameters.Item("Material")
Set oType = oParameters.Item("Type")
oLength.Value = Application.WorksheetFunction.Max(.Range("B" & oRow), .Range("C" & oRow)) * 2.54
oWidth.Value = Application.WorksheetFunction.Min(.Range("B" & oRow), .Range("C" & oRow)) * 2.54
oMaterial.Value = UCase(Material)
oType.Value = UCase(PlateType)
'Create new part
Call InventorFunctions.RuniLogic(CoverPlateInventor, "Create Cover Plate", False)
Call InventorFunctions.RuniLogic(CoverPlateInventor, "Drawing Creation", False)
Doc.Activate
Workbooks(FileName).Close
Workbooks.Open FileName:=Location & FileName, ReadOnly:=True
Set ListSheet = Workbooks(FileName).Sheets(SheetName)
End If
Call InventorFunctions.PlacePart(oInventor, PlateFile)
Call InventorFunctions.MovePart(oInventor, PlateFile, Point, Rotation)
oRow = oRow + 1
Loop
End With
ErrorHandler:
'Closing list of created plates
oInventor.ScreenUpdating = True
Workbooks(FileName).Close
End Sub
'Creates a copy of a file and opens it
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
Public Function CreateFromTemplate(TemplateFile As String) As Variant
Dim oInventor As Inventor.Application
Dim InventorObjects As Variant
Dim Doc As Inventor.Document
Dim NewFile As String
InventorObjects = OpenInventorFile(TemplateFile, False)
Set oInventor = InventorObjects(0)
Set Doc = InventorObjects(1)
Doc.Save
Doc.Close (True)
NewFile = FileControl.GetLatestFile(Split(TemplateFile, ".")(UBound(Split(TemplateFile, "."))))
CreateFromTemplate = OpenInventorFile(NewFile, False)
End Function
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\'Opens an existing file or creates a new one. Returns the file reference
'Pass it the template you wish to use for a new document. Acceptable template files listed below
' Assembly (Imperial).iam, ASTM Angle.ipt, ASTM Channel.ipt, ASTM Miscellaneous Channel.ipt, ASTM Rectangular Tube.ipt, ASTM Wide Flange Beam.ipt, _
' Copper Bar Part (Imperial).ipt, Grating Material Template (Imperial).ipt, Non-Metallic Sheet Outsourced.ipt, Part - Other (Imperial).ipt, _
' Roll Fromed Coil.ipt, Sheet Metal Part (Imperial).ipt, Weldment (Imperial).iam
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
Public Function OpenInventorFile(FileName As String, NewFile As Boolean) As Variant
On Error Resume Next
Dim InventorObjects(1) As Object
Dim Doc As Inventor.Document
Dim oInventor As Inventor.Application
Dim Location As String
Dim TemplateName As String
Dim DocType As DocumentTypeEnum
'Get open instance of inventor or open one if nothing is found
Set oInventor = GetObject(, "Inventor.Application")
If Err Then
Err.Clear
Set oInventor = CreateObject("Inventor.Application")
Do Until oInventor.Ready = True
Application.Wait (1)
Loop
For j = 1 To oInventor.ApplicationAddIns.Count
oAddin = oInventor.ApplicationAddIns.Item(j)
oStr = oStr & j & ") " & oAddin.DisplayName & " - " & oAddin.Activated
Next
End If
oInventor.Visible = True
'If this is an old file simply open it
If NewFile = False Then
Set Doc = oInventor.Documents.Open(FileName)
'If it is a new file then determine the template and document and add a new file
Else
Location = "C:\Work\Designs\Templates\2013\Inventor Templates\Imperial\"
TemplateName = Location & FileName
If FileName = "Assembly (Imperial).iam" Or FileName = "Weldment (Imperial).iam" Then
DocType = kAssemblyDocumentObject
Else
DocType = kPartDocumentObject
End If
Set Doc = oInventor.Documents.Add(DocType, TemplateName, True)
End If
Set InventorObjects(0) = oInventor
Set InventorObjects(1) = Doc
OpenInventorFile = InventorObjects
End Function
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
'Returns the latest instance of a file of the specified extension in a string. Asterisk can be used for any file type
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
Public Function GetLatestFile(Extension As String) As String
Dim FileSpec As String
Dim LatestFile As String
Dim Location As String
Dim FileList() As String
Dim FileName As String
Location = ActiveWorkbook.Path
FileSpec = Location & "*.*"
FileName = Dir(FileSpec)
Do While Len(FileName) > 0
If Split(FileName, ".")(UBound(Split(FileName, "."))) = Extension Then
If LatestFile <> "" Then
If FileDateTime(Location & FileName) > FileDateTime(LatestFile) Then
LatestFile = Location & FileName
End If
Else
LatestFile = Location & FileName
End If
End If
FileName = Dir
Loop
If LatestFile = "" Then
MsgBox ("No assemblies found")
Exit Function
Else
GetLatestFile = LatestFile
End If
End Function
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
I don't quite understand what or where you are trying to accomplish the save thing... but a few ideas....
oDoc.SaveAs("C:\FileNameHere.ext")
or BEFORE SAVE
oDoc.FullFileName = "C:\FileNameHere"
or to avoid dialogs...
invApp.SilentOperation = True
'Must also reset with
'invApp.SilentOperation = False
--------------------------------------
Did you find this reply helpful ? If so please use the 'Accept as Solution' or 'Like' button below.
Inventor 2018.2.3, Build 227 | Excel 2013+ VBA
ERP/CAD Communication | Custom Scripting
Machine Design | Process Optimization
iLogic/Inventor API: Autodesk Online Help | API Shortcut In Google Chrome | iLogic API Documentation
Vb.Net/VBA Programming: MSDN | Stackoverflow | Excel Object Model
Inventor API/VBA/Vb.Net Learning Resources: Forum Thread
Sample Solutions:Debugging in iLogic ( and Batch PDF Export Sample ) | API HasSaveCopyAs Issues |
BOM Export & Column Reorder | Reorient Skewed Part | Add Internal Profile Dogbones |
Run iLogic From VBA | Batch File Renaming| Continuous Pick/Rename Objects
Local Help: %PUBLIC%\Documents\Autodesk\Inventor 2018\Local Help
Ideas: Dockable/Customizable Property Browser | Section Line API/Thread Feature in Assembly/PartsList API Static Cells | Fourth BOM Type
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
The thing is that I can't avoid the dialogue. I want the dialogue to pop up, the path to be initially declared, and the file to save without user input. I can't use save as because we use a number generator that occurs on save to determine file name so I have no idea ahead of time what the file is actually supposed to be called.
What I need is for it to open a document, perform a save action to the intended file path, let the save dialogue come up and then simply have the command manager click yes and record the name of the new file that is being opened so that I can then close the file that I was saving from and open the new file.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
So what you're saying is you have an event trigger set for before save that determines the save name of the file?
You are wanting to do a "Save copy as" kind of thing but give the file a new name, then open it?
Otherwise, unless your trigger is set on close or something weird, the new file should be already open before launching the save command, so there is no need to store the file name...
--------------------------------------
Did you find this reply helpful ? If so please use the 'Accept as Solution' or 'Like' button below.
Inventor 2018.2.3, Build 227 | Excel 2013+ VBA
ERP/CAD Communication | Custom Scripting
Machine Design | Process Optimization
iLogic/Inventor API: Autodesk Online Help | API Shortcut In Google Chrome | iLogic API Documentation
Vb.Net/VBA Programming: MSDN | Stackoverflow | Excel Object Model
Inventor API/VBA/Vb.Net Learning Resources: Forum Thread
Sample Solutions:Debugging in iLogic ( and Batch PDF Export Sample ) | API HasSaveCopyAs Issues |
BOM Export & Column Reorder | Reorient Skewed Part | Add Internal Profile Dogbones |
Run iLogic From VBA | Batch File Renaming| Continuous Pick/Rename Objects
Local Help: %PUBLIC%\Documents\Autodesk\Inventor 2018\Local Help
Ideas: Dockable/Customizable Property Browser | Section Line API/Thread Feature in Assembly/PartsList API Static Cells | Fourth BOM Type
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Sort of... I guess? It's not I Logic or VBA to my knowledge its a preprogrammed plug in that I have no access to. It seems to run when the command manager says save (in cases of locked files or new files) or save as. I've played around with the dialogue events but it won't trigger with dialogue events so I couldn't use that.