Eksport ścieżki modyfikacji makra według ścieżki zespołu

Macro
1

Witam

Mam mały problem przy próbie zmiany ścieżki do pliku eksportu w makrze:

Wiersze, które mają zostać zmienione, są następujące:

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

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

Chciałbym pobrać ścieżkę mojego zestawu zamiast C:\Temp

Oto mój niefunkcjonalny kod dla bazy:

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

Jeśli ktoś ma pomysł, suszyłem się przez godzinę na coś chyba bardzo głupiego...

2

Witam

Oto, co powinno zadziałać:

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

Pozdrowienia

1 polubienie
3

Działa, ale brakuje w nim części (nazwa pliku zajmuje ostatni katalog zamiast exclu.txt.

Wygląda na to, że nie podoba mu się ostatni \, gdy dodasz \Excluded przed .txt

4

Byłem tym, który uruchomił tworzenie pliku o nazwie "exclu.txt", wydawało mi się to dziwne, ale to dlatego, że trochę źle zinterpretowałem pytanie.

Więc tak, nie chce tworzyć pliku "exclu.txt" tam, gdzie chcesz, ponieważ folder nie istnieje, więc musisz go utworzyć wcześniej, jeśli nie istnieje:

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

Ups, zapomniałem o drugim argumencie na linii:

Jeśli Dir(soutputFolder) = "" Następnie

Otrzymuje on brzmienie:

Jeśli Dir(soutputFolder, vbDirectory) = "" Następnie

Pozdrowienia

6

Witam

Dziękuję d.roger twoje rozwiązanie, które działa idealnie, pozwoliło mi znaleźć mój błąd.

Chciałem jednak tylko pobrać ścieżkę do folderu zestawu i w tym folderze zapisać swój plik Exclu.txt.

To właśnie stworzenie folderu sprawiło, że pchła wpadła mi do ucha, ponieważ teczka mojego zespołu z pewnością już istnieje!

 

W każdym razie dziękuję za kod, który przynosi mi inną wiedzę. I nadal wybieram Twoją odpowiedź jako najlepszą, ponieważ odpowiedziałeś na moją prośbę, która po prostu nie była wcale jasna.

 

 

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