Good Morning all,
First off this is my first posting on here so I hope I am in the correct spot for this question.
I have made a macro for my fellow engineers and I to use to pull new part numbers from a master excel file form within solidworks. The code is suppose to open an excel file in the background read it, open a user form for part number info entry and then write that user input back to the excel file. After which it names the solidworks file with the newly created part number and assigns its description in the custom properties field performs a save and opens the save dialog box, which I want so we can select where to save the file. After the save dialog box closes it will save the excel sheet, close excel and message the user that the part number has been added.
As of now if the part is new and "clean" it will do everything perfectly just fine with no hiccups. However if you open an already existing part that you want to use and create a new part from, I want the ability to save it as a new part number. I am using ".SaveAs2()" along with ".SetSaveAsFileName()" which seems to be working but using the ".SaveAs2()" coupled with the "swCommands_SaveAs" dialog box seems like not an efficient way to go about this especially since when you get to the save dialog box and hit cancel, it cancels the save but it still writes the new number to the excel file and I would like it to cancel the write to excel and just end the sub. I have to ensure that people don't accidentally make part number in the master sheet.
Now I went this SaveAs route because before it was not changing the file name so it was just using the old file name which I didn't like and this was the only way I could figure out how to get it to work. I am also no vba guru so my knowledge is limited and my code may not be written in the most efficient manner so any constructive criticism would be nice as well.
So my question is I need a better way to do a save as and have the file name change to what was entered on the user form when trying to save over an opened part.
Option Explicit
Public originator As String
Public today_date As Date
Public part_class As String
Public part_description As String
Public product_line As String
Public lRow As Integer
Public xlApp As Excel.Application
Public xlBook As Excel.Workbook
Public xlSheet As Excel.Worksheet
Public part_num As String
Sub main()
Dim xlFile As String
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Master Part number excel path & file
xlFile = "\\PartNumbersTest.xlsx"
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Dim closeApp As String
Dim swApp As SldWorks.SldWorks
Set swApp = Application.SldWorks
Dim swModel As SldWorks.ModelDoc2
Set swModel = swApp.ActiveDoc
Dim swCustPropMgr As SldWorks.CustomPropertyManager
Set swCustPropMgr = swModel.Extension.CustomPropertyManager("")
Dim boolstatus As Boolean
Dim swModelExt As SldWorks.ModelDocExtension
Set swModelExt = swModel.Extension
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
Set xlApp = CreateObject("EXCEL.Application")
Set xlBook = xlApp.Workbooks.Open(xlFile)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'checks if someone else has the excel file open
If xlBook.ReadOnly = True Then
MsgBox xlFile & " " & "is already opened by another user"
xlBook.Close
Set xlBook = Nothing
xlApp.Quit
Set xlApp = Nothing
Exit Sub
End If
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'locates last populate row in part number sheet
With xlApp.Worksheets("Sheet1")
lRow = .Cells(.Rows.Count, 1).End(xlUp).row
End With
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'displays userform for part number input
userform1.Show
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'sets part number to file and adds Description to custom properties
swCustPropMgr.Set2 "Description", part_description
With xlApp.Worksheets("Sheet1")
part_num = .Cells(lRow, 7).Value
End With
'determins if swModel is a new "clean" part or if part already exists and need to save as a new part number
If False = swModel.SetTitle2(part_num) Then
boolstatus = swModelExt.SaveAs2(part_num, 0, (swSaveAsOptions_SaveReferenced + swSaveAsOptions_Silent), Nothing, "", False, False, False)
swModel.setsaveasfilename (part_num)
End If
swApp.RunCommand swcommands.swCommands_SaveAs, ""
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'Save and close excel master part number file
xlBook.Save
Set xlSheet = Nothing
xlBook.Close
Set xlBook = Nothing
xlApp.Quit
Set xlApp = Nothing
MsgBox "Part Number Added"
End Sub
**********************************************
userform code
**********************************************
Private Sub CommandButton1_Click()
'assigns user input values to public variables then writes those values back to excel file
originator = tbOriginator
part_class = ComboBox1.Text
part_description = tbDescription
product_line = tbProductLine
Unload userform1
lRow = lRow + 1
With xlApp.Worksheets("Sheet1")
.Cells(lRow, 1) = originator
.Cells(lRow, 2) = today_date
.Cells(lRow, 5) = part_class
.Cells(lRow, 8) = part_description
.Cells(lRow, 9) = product_line
End With
End Sub
Private Sub UserForm_Initialize()
Dim unique_number As Integer
Dim number_code As Integer
Dim i As Integer
today_date = Date
xlApp.Visible = False
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'populates userform part class combobox with the part class list on sheet 2 "part code list"
With xlApp.Worksheets("Part Code List")
For i = 2 To 79
If .Cells(i, 1).Value = "" Then
Exit For
End If
ComboBox1.AddItem (.Cells(i, 1).Value)
Next i
End With
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'populates userform textboxs with standard info not needing to be entered and a blank part number
With xlApp.Worksheets("Sheet1")
tbDate.Value = Date
tbNumberCode.Value = .Cells(lRow, 3)
tbUniqueNumber.Value = .Cells(lRow, 4)
tbPartNumber.Value = tbNumberCode & "-" & tbUniqueNumber & "-XXX"
End With
End Sub
