[VBA] Set the name of a .sldprt file based on a cell in the related parts family excel file

tmauduit · February 13, 2017, 8:14am

Hi all

After several unsuccessful attempts, I decided to come and get a little more help.

I need to retrieve the contents of a cell in an excel file and then define it as a file name.

The goal would therefore be:

-Recover the contents of the cell,

- Set it as a filename in a dialog box, and leave it editable for the user to interact,

- Save as: - either in a user-defined folder,

-or on the desk if too complicated.

I put you my piece of code made with the help of different tutorials/codes retrieved right and left

Dim swApp As Object

Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long

Sub main()

Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
Dim PartPath As String
Dim Pathsize As Long
Dim PathNoExtension As String
Dim NewFileName As String
Dim Workbooks As Integer

PartPath = Part.GetPathName
Pathsize = Strings.Len(PartPath)
PathNoExtension = Strings.Left(PartPath, Pathsize - 7)

'NewFileName = InputBox("Fill in the new name retrieved in excel", "Save a copy", NewFileName)
'If NewFileName = "" Then
NewFileName = Workbooks("DESIGNTABLE"). WorkSheets("Sheet1"). Cells(1, 9)

'End If

longstatus = Part.SaveAs2(NewFileName & ".sldprt", 0, 1, 0)
'swApp.CloseDoc PartPath 'closes old document
Set Part = swApp.OpenDoc6(NewFileName & ".sldprt", 1, 0, "", longstatus, longwarnings)

End Sub

gt22 · February 13, 2017, 10:41am

Question What is the name of your Excel cell?

Is it a concarenation of x cells?

since you want it to be the name of a file part

@+ ;-)

tmauduit · February 13, 2017, 10:45am

I changed the code, which is more efficient than the current one.

Sub SAVE() 'save as
Dim swApp As SldWorks.SldWorks
Dim SWmoddoc As SldWorks.ModelDoc2
Dim CODE As String
Dim nErrors As Long
Dim nWarnings As Long
Set swApp = Application.SldWorks
Set SWmoddoc = swApp.ActiveDoc

PathName = UCase(SWmoddoc.GetPathName)

If Right(PathName, 3) = "DRW" Then
    MesgBOX = MsgBox("Macro to be run only from a part or assembly", vbMsgBoxSetForeground, "Save-As")
    Exit Sub
    ElseIf Right(PathName, 3) = "PRT" Then
        DRWPath = Replace(PathName, "PRT", "DRW")
    ElseIf Right(PathName, 3) = "ASM" Then
        DRWPath = Replace(PathName, "ASM", "DRW")
End If

FilePath = Left(PathName, InStrRev(PathName, "\"))

FileName = Right(PathName, Len(PathName) - InStrRev(PathName, "\"))

RET = MsgBox("Did you copy the pulley name in Excel?", vbOKCancel + vbExclamation + vbMsgBoxSetForeground + vbSystemModal, "Save-As")

If RET = vbCancel Then End
Do

NewName = InputBox("Please indicate the new name retrieved from Excel" & vbNewLine, "Save", FR label)

If StrPtr(NewName) = 0 Then
MsgBox "Procedure Canceled"

Exit Sub
End If

Do While InStr(NewName, Chr(34)) > 0 or InStr(NewName, "\") > 0 or InStr(NewName, "/") > 0 _
or InStr(NewName, ":") > 0 or InStr(NewName, "*") > 0 or InStr(NewName, "?") > 0 or InStr(NewName, "<") > 0 or InStr(NewName, ">") > 0 or InStr(NewName, "|") > 0

        NewName = InputBox("Warning, the name contains at least one of the forbidden characters \/:*?""<>|" & vbNewLine & vbNewLine & _
        "Please enter the new name: ", "Save-As", NewName)
    Loop

Loop While NewName = ""

Do
    FilePath = InputBox("In which folder do you want to save the pulley?", "Save-as", FilePath)
    If StrPtr(FilePath) = 0 Then
        MsgBox "Procedure Canceled"
        Exit Sub
    End If
    If Right(FilePath, 1) <> "\" Then FilePath = FilePath & "\"

    If Dir$(FilePath) <> "" Then
        EXISTS = 1
    Else: MsgBox "The directory does not exist, please create it"
    Debug.Print Dir$(FilePath)
    End If

Loop While EXISTS <> 1

Set swModel = swApp.ActivateDoc2(PathName, False, nErrors)

If (SWmoddoc.GetType = swDocASSEMBLY) Then

SWmoddoc.SaveAs (FilePath + NewCode + NewName + ". SLDASM")
ElseIf (SWmoddoc.GetType = swDocPART) Then

SWmoddoc.SaveAs (FilePath + NewName + ". SLDPRT")
End If

End Sub

My cell doesn't have a particular name. It simply retrieves information from the spreadsheet by adding letters to identify the parameters retrieved from the spreadsheet. The file name looks like this:

TXXXXX_PD_XXXX - P_M8_C2_R

The parameters retrieved (and therefore variable) are: 8, 2 and R, everything else is invariable.

Thank you for your answer:)

gt22 · February 13, 2017, 11:12am

See this link

https://forum.excel-pratique.com/excel/creation-de-dossier-a-partir-de-valeur-de-cellule-t69912.html

http://www.commentcamarche.net/forum/affich-32704381-creation-dossier-par-rapport-a-une-valeur-cellule-excel?page=2

https://www.developpez.net/forums/d1549758/logiciels/microsoft-office/excel/creation-dossier-excel-partir-d-cellule/

tutorial for the creation of a file

http://warin.developpez.com/access/fichiers/

not tested to see

@+ ;-)

tmauduit · February 13, 2017, 12:40pm

I looked in detail at what you posted, but it doesn't really correspond to my request, all I would like is to just retrieve an info in a cell, and then display it in a dialog box before saving the file. The folder in which the part will go is already created.

Cyril.f · February 13, 2017, 1:23pm

Hello

I do not quite understand the request. The excel file in which you type, is it a selection by the user that becomes the record name or is it a fixed cell in which you will look for the information?

tmauduit · February 13, 2017, 2:18pm

@Cyril.f

My cell is a concatenation of some information from my spreadsheet and text. It is always in the same place because there is only one sheet, and one excel file.

yvest · February 13, 2017, 4:14pm

Hello

Although I have a hard time understanding the usefulness if you go through a family of parts that create different configurations for you, you will find the code that corresponds to what I understood from your question:)

Either:

Open an excel workbook from solidworks
Retrieve the value of a cell
Rename a file (with or without the old name)
Save a copy with the new name

I added a dialog box to search for the excel workbook.

The code:

'Think about adding Microsoft excel and Office references

Dim swApp As SldWorks.SldWorks
Dim xlApp As Excel.Application
Dim swDoc As ModelDoc2
Dim fDialog As Office.FileDialog
Dim xlDoc As Excel.Workbook
Dim xlCell As Excel.Range
Dim DocName, NewName, Folder, NewPath As String
Dim fso As Object

Sub main()

Set swApp = Application.SldWorks
Set swDoc = swApp.ActiveDoc
Set xlApp = New Excel.Application
Set fDialog = xlApp.FileDialog(msoFileDialogOpen)
'You can add options to fDialog to filter or open only one document
If fDialog.Show = -1 Then
Set xlDoc = xlApp.Workbooks.Open(fDialog.SelectedItems(1))
Set xlCell = xlDoc.Worksheets(1). Range("A1")
'I create an fso object to easily manipulate files
Set fso = CreateObject("Scripting.fileSystemObject")

DocName = swDoc.GetPathName
NewName = fso. GetBaseName(DocName) & " " & xlCell.Value
'I am recreating the new file name from the old one
NewPath = fso. GetParentFolderName(DocName) & "\" & NewName & "." & fso.getextensionName(DocName)
'I record
f = swDoc.SaveAs(NewPath)

End If

'We think of destroying what is no longer useful

Set fso = Nothing
Set xlApp = Nothing
End Sub

Have fun:)

gt22 · February 13, 2017, 6:35pm

tmauduit

I looked in detail at what you posted, but it doesn't really correspond to my request, all I would like is to just retrieve an info in a cell, and then display it in a dialog box before saving the file. The folder in which the part will go is already created.

The question is

I need to retrieve the contents of a cell from an excel file and then set it as a file name.

The goal would therefore be:

-Recover the contents of the cell,

- Set it as a filename in a dialog box, and leave it editable for the user to interact,

so in the links the answer is there ;-(

Now you want to change the name of a file that you have already created??????????????????????????

Maybe you need to know what you want!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

@+;-( version not happy at all ;-(

ps en + for what use????????????

tmauduit · February 14, 2017, 8:19am

@gt22, I retrieve the name from the cell, and inject it as a new name for a save-sub- in an existing folder.

@industrialcadservice I'm looking at this!

Thank you for your answers:)

tmauduit · February 14, 2017, 10:08am

Well, small modification using smartproperties: I define my TITLE3 using Excel, then retrieve it by the macro, but still a problem, more on the solidworks side, indeed, the smart properties are linked either to the document, or to the configuration, and my title 3 changes in the configuration, but not in the document, and it's the one of the document that I get back, and not the one of the configuration... Does anyone know where the wolf is?

Snippet of code below

Set SWmoddoc = swApp.ActiveDoc

PathName = UCase(SWmoddoc.GetPathName)

If Right(PathName, 3) = "DRW" Then
    MesgBOX = MsgBox("Macro to be run only from a part or assembly", vbMsgBoxSetForeground, "Save-As")
    Exit Sub
    ElseIf Right(PathName, 3) = "PRT" Then
        DRWPath = Replace(PathName, "PRT", "DRW")
    ElseIf Right(PathName, 3) = "ASM" Then
        DRWPath = Replace(PathName, "ASM", "DRW")
End If

FilePath = Left(PathName, InStrRev(PathName, "\"))

FileName = Right(PathName, Len(PathName) - InStrRev(PathName, "\"))

RET = MsgBox("Did you copy the name of the pulley/drum in Excel?", vbOKCancel + vbExclamation + vbMsgBoxSetForeground + vbSystemModal, "Save-As")

If RET = vbCancel Then End
Do

TITLE 3
NewName = SWmoddoc.CustomInfo("TITLE3")

'We display it
RET = MsgBox(NewName, vbMsgBoxSetForeground)
'NewName = InputBox("Please indicate the new name retrieved from Excel" & vbNewLine, "Save")

'If StrPtr(NewName) = 0 Then
'MsgBox "Procedure Cancelled"

'Exit Sub
'End If

Thanks in advance

yvest · February 14, 2017, 11:13am

Hello

I'm not in front of my PC but I assume that SW recovers the property of the active configuration. Have you tried your macro with a different configuration?

If not, can you explain to us the purpose of such manipulations? Because personally, I don't see the point...

tmauduit · February 14, 2017, 1:13pm

I did try with another configuration, but the result is the same, the title change is only done on the excel side and the configuration, and not in the .prt file itself

The point is that all this is hidden from the end user: he configures, launches the macro, and validates or not the name. I just provide an excel with its parameters to enter. The creation of the reference does not appear at any time in excel for the user.

tmauduit · February 15, 2017, 10:58am

Sub SAVE() 'save as
Dim swApp As SldWorks.SldWorks
Dim Part As SldWorks.ModelDoc
Dim CODE As String
Dim nErrors As Long
Dim nWarnings As Long

Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc

PathName = UCase(Part.GetPathName)

If Right(PathName, 3) = "DRW" Then
    MesgBOX = MsgBox("Macro to be run only from a part or assembly", vbMsgBoxSetForeground, "Save-As")
    Exit Sub
    ElseIf Right(PathName, 3) = "PRT" Then
        DRWPath = Replace(PathName, "PRT", "DRW")
    ElseIf Right(PathName, 3) = "ASM" Then
        DRWPath = Replace(PathName, "ASM", "DRW")
End If

FilePath = Left(PathName, InStrRev(PathName, "\"))

FileName = Right(PathName, Len(PathName) - InStrRev(PathName, "\"))

RET = MsgBox("Have you finished setting up your part?", vbOKCancel + vbExclamation + vbMsgBoxSetForeground + vbSystemModal, "Save-As")

If RET = vbCancel Then End
Do
    'we get the TITLE back3
    NewName = Part.CustomInfo("TITLE3")
    'We display it
    'RET = MsgBox(NewName, vbMsgBoxSetForeground)
    NewName = InputBox("Validate or change the part name" & vbNewLine & vbNewLine, "Name Definition", NewName)

If StrPtr(NewName) = 0 Then
MsgBox "Procedure Canceled"

Exit Sub
End If

Do While InStr(NewName, Chr(34)) > 0 or InStr(NewName, "\") > 0 or InStr(NewName, "/") > 0 _
or InStr(NewName, ":") > 0 or InStr(NewName, "*") > 0 or InStr(NewName, "?") > 0 or InStr(NewName, "<") > 0 or InStr(NewName, ">") > 0 or InStr(NewName, "|") > 0

        NewName = InputBox("Warning, the name contains at least one of the forbidden characters \/:*?""<>|" & vbNewLine & vbNewLine & _
        "Please enter the new name: ", "Save-As", NewName)
    Loop

Loop While NewName = ""

Do
    FilePath = InputBox("In which folder do you want to save the part?", "Save-as", FilePath)
    If StrPtr(FilePath) = 0 Then
        MsgBox "Procedure Canceled"
        Exit Sub
    End If
    If Right(FilePath, 1) <> "\" Then FilePath = FilePath & "\"

    If Dir$(FilePath) <> "" Then
        EXISTS = 1
    Else: MsgBox "The directory does not exist, please create it"
    Debug.Print Dir$(FilePath)
    End If

Loop While EXISTS <> 1

Set swModel = swApp.ActivateDoc2(PathName, False, nErrors)

If (Part.GetType = swDocASSEMBLY) Then

Part.SaveAs (FilePath + NewName + ". SLDASM")
ElseIf (Part.GetType = swDocPART) Then

Part.SaveAs (FilePath + NewName + ". SLDPRT")
End If

End Sub

The problem on the VBA side is solved for me, I open another topic for the problem with Smart Properties