Export van macromodi-pad op assemblagepad

Hallo

Ik heb een klein probleem bij het wijzigen van het pad van het exportbestand in een macro:

De te wijzigen regels zijn de volgende:

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

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

Ik wil graag het pad van mijn assembly ophalen in plaats van C:\Temp

Hier is mijn niet-functionele code voor 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

Als iemand een idee heeft, ik heb een uur zitten drogen voor iets dat waarschijnlijk heel stom is...

Hallo

Dit is wat zou moeten werken:

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

Vriendelijke groeten

1 like

Het werkt wel, maar er ontbreekt een deel (de bestandsnaam neemt de laatste map in plaats van exclu.txt.

Het lijkt erop dat hij de laatste \ niet leuk vindt als je \Uitgesloten toevoegt voor de .txt

Ik was degene die de creatie van het bestand met de naam "exclu.txt" heeft geactiveerd, het leek me raar, maar het komt omdat ik de vraag een beetje verkeerd had geïnterpreteerd.

Dus ja, het wil het "exclu.txt"-bestand niet maken waar je wilt, omdat de map niet bestaat, dus je moet het eerder maken als het niet bestaat:

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

 

Oeps, ik vergat het tweede argument op de lijn:

Als Dir(soutputFolder) = "" dan

Het wordt vervangen door:

Als Dir(soutputFolder, vbDirectory) = "" dan

Vriendelijke groeten

Hallo

Bedankt d.roger je oplossing die perfect werkt, stelde me in staat om mijn fout te vinden.

Ik wilde echter alleen het pad naar de assemblagemap ophalen en in deze map mijn Exclu.txt bestand opslaan.

Het was de creatie van de map die de vlo in mijn oor bracht, aangezien de map van mijn assemblage noodzakelijkerwijs al bestaat!

 

In ieder geval bedankt voor de code die me andere kennis brengt. En ik kies nog steeds jouw antwoord als het beste omdat je mijn verzoek hebt beantwoord, dat gewoon helemaal niet duidelijk was.

 

 

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