Improve Macro X_T to create a folder so non-existent on Solidworks?

Macro
1

I already have a macro (which I attach as an attachment) that allows me to export a part or assembly in X_T in a "X_T FILES" subfolder.

I would need that when the "X_T FILES" folder doesn't exist, it can create one to insert the exported file into it, how should I program this?

The current program:

 

Sub Sauvegarde_X_T()


Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Dim Locatie As String
Dim Locatie_aangepast As String
Dim OpenDoc As Object
Dim Extensie_nieuw As String
Dim Extensie_oud As String
Dim retval As String
Dim Naam As String
Dim Naam_aangepast As String

 

Set swApp = CreateObject("SldWorks.Application")
Set swModel = swApp.ActiveDoc
Set OpenDoc = swApp.ActiveDoc()

Extensie_oud = ". SLDASM"
Extensie_nieuw = ". X_T"
Locatie = OpenDoc.GetPathName
Locatie_aangepast = Left(Locatie, Len(Locatie) - 7)
retval = Dir$(Locatie_aangepast & Extensie_oud)
Naam = Dir$(Locatie)
Naam_aangepast = Left(Naam, Len(Naam) - 7)
Titel = OpenDoc.GetTitle
Titel = Left(Titel, (Len(Titel)))


    
Set Part = swApp.ActiveDoc

Dim FilePath As String, FileName As String

FilePath = Left(Locatie, InStrRev(Locatie, "\"))
MsgBox FilePath & "X_T FILES" & Naam_aangepast & Extensie_nieuw
longstatus = Part.SaveAs3(FilePath & "FILES X_T\" & Naam_aangepast & Extensie_nieuw, 0, 0)

End Sub


save_x_t_-_fichiers_x_t.zip
2

See this page

http://www.beta.lynkoa.com/forum/3d/macro-enregistrement-en-pdf-dans-un-dossier-specifique

a macro @ jfaradon who is in theory someone who knows what he's talking about
 
can be the beginning of a snippet's orientation
 
@+ ;-))
 
 
 
3

Hi, we must add after this line:

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

If dir$(FilePath) ="" then

Mkdir FilePath

End if

4

@ PL just add what since you say you just add after this line but there is nothing

@+

1 Like
5
Yes GT sorry the answer went too fast, I edited afterwards.
1 Like
6

and yes @ PL the problem is there

the re-edition of the answers without any re-edition ref

and yet x times asked our CM

As far as possible, it is necessary to avoid republishing an answer

To give an answer

@+ ;-))

7

@ PL when you look at the communication thread of the answers

your reedited answer keeps the same time

So with regard to the time my answer came afterwards and yet it is not the case

so incomprehension of the reading of the answers on this communication thread

The notion of reissue should be notified for greater clarity of the communication thread

and this is often the case

which of + is often answered to a question without an answer at first glance

and when you publish it, you are always the first to publish it

but if we do a refresh we realize that it is not and that a person has already answered

The discomfort is there most often

@+ ;-))

 

@+ ;-))

8

It doesn't work...

It doesn't create a file if it doesn't exist.

9
Try with dir$ instead of dir
10

I don't really understand ...

I shouldn't add things between the ""s?

Like the name of the folder it should create? Because I don't understand how the program will create the folder with the right name?

 

If dir$(FilePath) ="" then

Mkdir FilePath

End if

11

Hello

The MkDir function does not accept creating a different repository on a different drive than the one on which the macro is executed.

12

Prefer the method: My.Computer.FileSystem.CreateDirectory

Read more here: https://msdn.microsoft.com/fr-fr/library/2wwkaadb%28v=vs.90%29.aspx

13

And does that work instead?

If Dir$(FILEPATH, vbDirectory) = "" Then
    Shell ("cmd /c mkdir """ & FILEPATH & """")
End If

14

It doesn't work either. I think I'm going to give up on the idea.

If anyone has another suggestion, I'm always interested.

Thanks all the same to those who took the time to search.

15

I just tested this successfully:

Sub main()
   
Dim swApp As Object, Part As Object, OpenDoc As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Dim Locatie As String, Locatie_aangepast As String, Extensie_nieuw As String, Extensie_oud As String, retval As String
Dim Naam As String, Naam_aangepast As String, FilePath As String, FileName As String, FolderPath As String

Set swApp = CreateObject("SldWorks.Application")
Set swModel = swApp.ActiveDoc
Set OpenDoc = swApp.ActiveDoc()

Extensie_oud = ". SLDASM"
Extensie_nieuw = ". X_T"
Locatie = OpenDoc.GetPathName
Locatie_aangepast = Left(Locatie, Len(Locatie) - 7)
retval = Dir$(Locatie_aangepast & Extensie_oud)
Naam = Dir$(Locatie)
Naam_aangepast = Left(Naam, Len(Naam) - 7)
Titel = OpenDoc.GetTitle
Titel = Left(Titel, (Len(Titel)))
    
Set Part = swApp.ActiveDoc

FilePath = Left(Locatie, InStrRev(Locatie, "\"))
FolderPath = FilePath & "X_T FILES"

If Dir(FilePath, vbDirectory + vbHidden) <> "" Then
        If Dir(FolderPath, vbDirectory + vbHidden) = "" Then _
            MkDir FolderPath
End If

longstatus = Part.SaveAs3(FilePath & "FILES X_T\" & Naam_aangepast & Extensie_nieuw, 0, 0)

End Sub

 

The code snippet comes from: http://excel.developpez.com/faq/?page=FichiersDir#MkDir

The www.developpez.com forum is a very good forum where you can find a lot of information and serious participants. I strongly recommend.


sauvegarder_xt.swp
16

I just tested the macro you put in, it bugs and it gives me this:


sans_titre.jpg
17

There's no reason why it shouldn't work! What are the errors when you tested my code?

And in the last example, it looks like you don't have a file open in SolidWorks.

 

1 Like
18

Do you have an open room?

19

It's okay I solved the problem, I found on a forum:

"this is actually a fairly common error, but it is related to a missing reference in the VBA project (it happens if the work/home versions are different or absent)

Tools>References in the VBE editor uncheck the missing references and/or replace them with the available versions."

 

Ducou does it work!!!!!!!!!!!!!

Thanks guys!

1 Like