Macro modi chemin export par chemin de l'assemblage

Macro
1

Bonjour,

Je rencontre un petit soucis en voulant modifier le chemin du fichier d'export dans une macro:

Les lignes à modifier sont les suivantes:

Set FileList = fso.CreateTextFile("C:\Temp\Exclu.txt", 8, -2)

Shell "notepad.exe ""C:\Temp\Exclu.txt""", vbNormalFocus

Je souhaiterais récupérer le chemin de mon assemblage à la place de C:\Temp

Voici mon code non fonctionnel pour base:

Sub main()

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set Assembly = swApp.ActiveDoc
Set myAsy = Assembly



    '**********Chemin d'export MEP**********
    '*******Récup chemin existant***********

    sOutputFolder = Left(swModel.GetPathName(), Len(swModel.GetPathName()) - 7)
    sOutputFile = sOutputFolder & "\Exclu.txt"
    Debug.Print sOutputFile

Set fso = CreateObject("Scripting.FileSystemObject")


'Set FileList = fso.CreateTextFile("C:\Temp\Exclu.txt", 8, -2)

Set FileList = fso.CreateTextFile(sOutputFile, 8, -2)

    
myCmps = myAsy.GetComponents(False)

For i = 0 To UBound(myCmps)
Set myCmp = myCmps(i)
If myCmp.ExcludeFromBOM Then
FileList.Write myCmp.Name2 & vbCrLf

End If
Next i

FileList.Close

Shell "notepad.exe ""C:\Temp\Exclu.txt""", vbNormalFocus


End Sub

Si quelqu'un à une idée, cela fait une heure que je sèche pour quelque chose de sûrement très bête...

2

Bonjour,

Voici qui devrait fonctionner :

Sub main()

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set Assembly = swApp.ActiveDoc
Set myAsy = Assembly

    '**********Chemin d'export MEP**********
    '*******Récup chemin existant***********

    sOutputFolder = Left(swModel.GetPathName(), Len(swModel.GetPathName()) - 7)
    'soutputfile = sOutputFolder & "\Exclu.txt"
    soutputfile = sOutputFolder & ".txt"
    Debug.Print soutputfile

Set fso = CreateObject("Scripting.FileSystemObject")

'Set FileList = fso.CreateTextFile("C:\Temp\Exclu.txt", 8, -2)

Set FileList = fso.CreateTextFile(soutputfile, 8, -2)
    
myCmps = myAsy.GetComponents(False)

For i = 0 To UBound(myCmps)
Set myCmp = myCmps(i)
If myCmp.ExcludeFromBOM Then
FileList.Write myCmp.Name2 & vbCrLf

End If
Next i

FileList.Close

'Shell "notepad.exe ""C:\Temp\Exclu.txt""", vbNormalFocus
Shell "notepad.exe """ & soutputfile & """", vbNormalFocus

End Sub

Cordialement,

1 « J'aime »
3

Cela fonctionne effectivement mais il manque une partie (le nom de fichier prend le dernier répertoire au lieu de exclu.txt.

Il semblerait qu'il n'apprécie pas le dernier \ quand on ajout \Exclu avant le .txt

4

C'est moi qui est viré la création du fichier nommé "exclu.txt", ça me paraissait bizarre mais c'est que j'avais un peu mal interprété la question.

Donc, oui il ne veut pas créer le fichier "exclu.txt" là ou tu veux car le dossier n'existe pas, il faut donc le créer avant si non existant :

Sub main()

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set Assembly = swApp.ActiveDoc
Set myAsy = Assembly

    '**********Chemin d'export MEP**********
    '*******Récup chemin existant***********

    soutputFolder = Left(swModel.GetPathName(), Len(swModel.GetPathName()) - 7)
    soutputfile = soutputFolder & "\Exclu.txt"
    Debug.Print soutputfile

If Dir(soutputFolder) = "" Then
    MkDir soutputFolder
End If

Set fso = CreateObject("Scripting.FileSystemObject")

'Set FileList = fso.CreateTextFile("C:\Temp\Exclu.txt", 8, -2)

Set FileList = fso.CreateTextFile(soutputfile, 8, -2)
    
myCmps = myAsy.GetComponents(False)

For i = 0 To UBound(myCmps)
Set myCmp = myCmps(i)
If myCmp.ExcludeFromBOM Then
FileList.Write myCmp.Name2 & vbCrLf

End If
Next i

FileList.Close

'Shell "notepad.exe ""C:\Temp\Exclu.txt""", vbNormalFocus
Shell "notepad.exe """ & soutputfile & """", vbNormalFocus

End Sub

 

5

Oups, j'ai oublié le deuxième argument sur la ligne :

If Dir(soutputFolder) = "" Then

C'est à remplacer par :

If Dir(soutputFolder, vbDirectory) = "" Then

Cordialement,

6

Bonjour,

Merci d.roger ta solution qui fonctionne parfaitement, m'a permis de trouver mon erreur.

Cependant je voulais juste récupérer le chemin du dossier de l'assemblage et dans ce dossier enregistrer mon fichier Exclu.txt.

C'est la création de dossier qui m'a mis la puce à l'oreille puisque le dossier de mon assemblage est obligatoirement déjà existant!

 

Merci quand même pour le code qui m'apporte d'autre connaissance. Et je choisit tous de même ta réponse comme la meilleure car tu as bien répondu à ma demande, qui n'était juste pas clair du tout.

 

 

Sub main()

Dim swModel                     As SldWorks.ModelDoc2

Dim swPart                      As SldWorks.PartDoc

Dim bRet                        As Boolean

Dim MyPath                      As String

Dim MyFolder                    As String

 

Set swApp = Application.SldWorks
Set Assembly = swApp.ActiveDoc
Set myAsy = Assembly
Set swModel = swApp.ActiveDoc

 



'**********Chemin d'export MEP**********
'*******Récup chemin existant***********

MyFolder = CurDir$
Debug.Print "Current Folder = " & MyFolder

soutputfile = MyFolder & "\Exclu.txt"
Debug.Print soutputfile



Set fso = CreateObject("Scripting.FileSystemObject")

'On créer le fichier .txt

Set FileList = fso.CreateTextFile(soutputfile, 8, -2)

    
myCmps = myAsy.GetComponents(False)


For i = 0 To UBound(myCmps)
Set myCmp = myCmps(i)

If myCmp.ExcludeFromBOM Then
FileList.Write myCmp.Name2 & vbCrLf
End If
Next i

FileList.Close

'On ouvre le fichier avec le bloc note
Shell "notepad.exe """ & soutputfile & """", vbNormalFocus

End Sub