Запуск макроса по всем файлам

[elteom 0]

Привет, земляне!

Скоромный вопрос.

У меня есть макрос.

Я хотел бы применить его ко всем файлам деталей в папке проекта его подкаталогах.

Не открывая каждую деталь по отдельности.

Спс.

[SERoz 201]

Привет инопланетник

Желание похвальное...

И кто мешает???

Пж...

[Хулиос 1]

И кто мешает???

Ты ничё не понял ))

Надо так:

Запуск макроса и применение его ко всем файлам деталей в папке проекта его подкаталогах,

не открывая каждую деталь по отдельности...

ОТ ИМЕНИ ВСЕХ ЗЕМЛЯН,

РАЗРЕШАЮ!

[Kelny 1 271]

У меня есть макрос.

Я хотел бы применить его ко всем файлам деталей в папке проекта его подкаталогах.

Если уж вы до макросов доросли, то собственно в чём проблема? :

Sub main()

Dim swApp As Object

Dim Part As Object

Dim longstatus As Long, longwarnings As Long

'Необходима ссылка на библиотеку Microsoft Scripting Runtime (scrrun.dll)

Dim fso As Scripting.FileSystemObject, f As Scripting.Folder

Dim fileList As Files, fileSelect As File



Set swApp = Application.SldWorks

Set fso = CreateObject("Scripting.FileSystemObject")

Set f = fso.GetFolder("C:\") 'Ваша папка

Set fileList = f.Files

For Each fileSelect In fileList

	'открыть файл детали

	Set Part = swApp.OpenDoc6(fileSelect, swDocPART, 0, "", longstatus, longwarnings)

	If Part Is Nothing Then Exit Sub

	'выполнить макрос

	'swApp.RunMacro filePathName, ModuleName, ProcedureName

	swApp.RunMacro "C:\Macros.swp", "ModuleMacros", "Main"

	'сохранить файл

	Part.Save2 False

	Set Part = Nothing

	'закрыть файл

	swApp.CloseDoc fileSelect

Next

End Sub

[elteom 0]

Ну зачем так.

Таких "рецептов" и я могу много написать.

Марос у меня не мой. (неможко подправил, глядя на его собстенные внутренности)

Я не макрописатель. Учить если честно очень некогда...

[moget 0]

Sub main()

Dim swApp As SldWorks.SldWorks

Dim Part As Object

Dim pPartName As String

Dim longstatus As Long, longwarnings As Long

'Необходима ссылка на библиотеку Microsoft Scripting Runtime (scrrun.dll)

Dim fso As Scripting.FileSystemObject, f As Scripting.Folder

Dim fileList As Files, fileSelect As File

Dim boolstatus As Boolean

Set swApp = Application.SldWorks

Set fso = CreateObject("Scripting.FileSystemObject")

Set f = fso.GetFolder("C:\Мои чертежи") 'Ваша папка

Set fileList = f.Files

For Each fileSelect In fileList

'открыть файл детали

Set Part = swApp.OpenDoc6(fileSelect, swDocPART, 0, "", longstatus, longwarnings)

'If Part Is Nothing Then Exit Sub

Set swModel = swApp.ActiveDoc

boolstatus = swModel Is Nothing

If boolstatus = False Then

'выполнить макрос

'swApp.RunMacro filePathName, ModuleName, ProcedureName

swApp.RunMacro "C:\Macros.swp", "ModuleMacros", "Main"

'сохранить файл

Part.Save2 False

Set Part = Nothing

'закрыть файл

swApp.CloseDoc fileSelect

End If

Next

End Sub

Вот позволил себе немного отредактировать макрос от Kelny. Теперь макрос работает даже если в папке есть не только детали *.sldprt

[elteom 0]

Збазибо, Друк! Скоро понадобица.

[elteom 0]

Не выходит из меня программист...

В референсы добавил модуль. (скачал, положил в папку с макросами и добавил к нему пудь)

Добавил прямую ссылку на запускаемый фаел, модуль, метод...

[Kelny 1 271]

В референсы добавил модуль.

Если и добавили, то похоже не тот.

Замените:

Dim fso As Scripting.FileSystemObject, f As Scripting.Folder

Dim fileList As Files, fileSelect As File

этим:

Dim fso As Object, f As Object

Dim fileList As Object, fileSelect As Object

[elteom 0]

ТЭКС...

Макрус запустился... но выполнился на открытом документе (сборки).

Другие фаилы в папке не тронул...

В коде я вижу место (зеленым отметил) я не понял, скрипт получает путь к директории, или его надо вбивать руками.

Вроде GetFolder- это типа получить папку? Что в скобках указать?

[moget 0]

ТЭКС...

Макрус запустился... но выполнился на открытом документе (сборки).

Другие фаилы в папке не тронул...

В коде я вижу место (зеленым отметил) я не понял, скрипт получает путь к директории, или его надо вбивать руками.

Вроде GetFolder- это типа получить папку? Что в скобках указать?

... надо вбивать ручками. Вот держи не мучайсяПакетная_обработка_файлов.rar

[ssv22 17]

ТЭКС...

Макрус запустился... но выполнился на открытом документе (сборки).

Другие фаилы в папке не тронул...

В коде я вижу место (зеленым отметил) я не понял, скрипт получает путь к директории, или его надо вбивать руками.

Вроде GetFolder- это типа получить папку? Что в скобках указать?

Там же в коменнтариях написано: "Ваша папка"

Если она постоянная или одна-единственная, то и надо вбить туда путь к ней.

Если нет, то перед этим надо путем еще некоторых манипуляций сосздать интерфейс для выбора нужной папки.

Все очень просто :-)

[elteom 0]

Там же в коменнтариях написано: "Ваша папка"

Если она постоянная или одна-единственная, то и надо вбить туда путь к ней.

Если нет, то перед этим надо путем еще некоторых манипуляций сосздать интерфейс для выбора нужной папки.

Все очень просто :-)

Ну я вписал руками. Но ничево чота там не произошло в этой папке...

[elteom 0]

Может настало время освежить техтребование к сабжу.

- Запустить сабж.

- Сабж спрашивает какой макрос запустить?

- Сабж не просит указывать папку. А выполняет макрос в текущей и всех вложенных папках, применительно к деталям.

Текущей папкой считаем папку открытой модели.

Для чего мне это нужно. Есть скрипт, который определяет размеры детали по осям и записывает их с в свойства деталей.

После того, как сборка готова, я запускаю этот скрипт (пока руками) в каждой детали.

Везде где это требуется, в чертежах, спецификациях, комментариях есть соответствующие ячейки. Автоматом прописываются размеры, масса, меняются названия... кароче полный КОММУНИЗМ!!!!!!!!

Понятно, что если я вношу изменения и детали меняются, то мне нужно опять руками их искать и применять макрос. (но я могу что-то и пропустить)

Хочу просто в конце работы над проектом или после внесения изменений, нажать на ОДНУ кнопку и обновить все данные.

[moget 0]

Вот держи не мучайся Пакетная_обработка_файлов.rar ( 6,19 килобайт )

эта програмуля у тебя работает?

[elteom 0]

Не могу запустить.

Я положил ее в папку с проектом.

Вот такое сообщение.

Как она должна работать?

[elteom 0]

[Kelny 1 271]

Как она должна работать?

Как минимум должна иметь указанную библиотеку, а поскольку поисковики о ней не знают, то она, вероятно, самописная и без автора вам её не найти.

Макрус запустился... но выполнился на открытом документе (сборки).

Другие фаилы в папке не тронул...

Вероятно в папке не было файлов. Макрос не проверяет содержимое подпапок, для этого нужно вводить рекурсивный перебор, когда в случае обнаружения папки функция поиск снова ссылается на себя и продолжает поиск в подпапках, например, в VB реализуется следующим образом (достаточно просто): <noindex>http://www.vbnet.ru/faq/showtopic.asp?id=36</noindex>

Можно реализовать тоже самое и без компонентов для VB, используя алгоритм рекурсивного перебора и Scripting.FileSistemObject

а так же можно посмотреть:

<noindex>http://www.microsoft.com/Rus/Msdn/Activ/MS...ve/VBA/367.mspx</noindex>

<noindex>http://www.visual.2000.ru/develop/ms-vb/tips/0001-2.htm</noindex>

[Vadim_ryb_ 77]

Использование RunMacro (и RunMacro2) трудностей не вызывает, а вот можно ли передать параметры вызываемым из них Sub?