Выберите значение из пути для сохранения файла с помощью VBA
Я написал сценарий с использованием VBA для сохранения детали Solidworks в открытой сборке в виде файла шага в определенной папке. Это отлично работает для меня. Вот весь мой код.
'Declare variables
Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Dim PathInit, PathCut As String
Sub SaveFiles()
'Use opened file as active document
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
'Prepare path
PathInit = Part.GetPathName 'Determine file location of the assembly
PathCut = Left(PathInit, InStrRev(PathInit, "\")) 'Remove text after the last slash
'Open user form
UserParam.Show
End Sub
Public Sub UserInput(InputFS, InputMS As String)
Dim PartNrFS, PartNrMS As String
Dim ExtInit, ExtNew, PartNameFS, ProjectNr, XTFolder, REV As String
'New pathname
ExtInit = ".SLDPRT" 'Old extension
ExtNew = ".STEP" 'New extension (either step or xt)
XTFolder = "XT\"
ProjectNr = "1875" 'THIS PARAMETER MUST BE EXTRACTED FROM PATH
PartNrFS = InputFS 'Input from userform
PartNrMS = InputMS 'Input from userform
PartNameFS = "PartName"
REV = "[REV0]"
' OPEN SLDPRT AND SAVE AS STEP
Set Part = swApp.OpenDoc6(PathCut + PartNameFS + ExtInit, 1, 0, "", longstatus, longwarnings)
longstatus = Part.SaveAs3(PathCut + XTFolder + ProjectNr + "_" + PartNrFS + " " + PartNameFS + " " + REV + ExtNew, 0, 2)
End Sub
Однако я хочу использовать часть пути к новому имени файла. Путь детали выглядит следующим образом:
C:\Users\User\Folder1\Folder2\Folder3\Folder4\XXX_0000_XXXX\Folder5\Folder6\Folder7\Filename.SLDPPRT
Я хочу переименовать файл, используя часть исходного пути, а именно следующую папку: XXX_0000_XXXX, где X=буква, 0=цифра. Для каждого нового файла этот код разный. Например, это может быть ABC_0102_DEFG или YGS_1842_GEHV. Я хочу включать ТОЛЬКО цифры в имя файла.
В настоящее время это пример ввода: «FilenameOld.SLDPRT» и вывода: «FilenameNew.STEP». Желаемый результат должен выглядеть примерно так: «0000_FilenameNew.STEP». В моем коде это число — «ProjectNr» с заданным значением. Это значение следует исключить из пути. Дополнительный пример:
C:\Users\User\Folder1\Folder2\Folder3\Folder4\XYZ_7619_QWER\Folder5\Folder6\Folder7\7619_Filename.STEP.
Путь уже задан/сгенерирован. Итак, число в коде XXX_0000_XXXX известно. Еще сложнее то, что код не всегда находится в одном и том же месте. Его можно разместить между Папками 4-Папки 5, но также можно разместить, например, между папками. Папка3-Папка4. Может кто-нибудь помочь мне?
Пожалуйста, не стесняйтесь задавать любые вопросы. Заранее спасибо!
Спасибо за ваш ответ. Схема действительно такая, как я написал. Два подчеркивания всегда включены. Я опубликовал свой код, чтобы дать больше разъяснений. Я посмотрю на ваш код и посмотрю, смогу ли я использовать его правильно. Приятно провести вечер. :)
Когда буду дома, превращу тестовый (дидактический) подпрограмму в функцию. Его следует вызывать с полным именем исходного файла и возвращать новое имя. Итак, интеграцию следует упростить...
Ответы 1
Пожалуйста, используйте следующую функцию:
Function changeFileName(initName As String, strExtension As String) As String
Dim FileName As String, FoldPath As String, arr, arrEl, El
Dim NumPart As Long, newFileName As String, fileNoExtention As String
arr = Split(initName, "\")
For Each El In arr
arrEl = Split(El, "_")
If UBound(arrEl) = 2 Then
If IsNumeric(arrEl(1)) Then
NumPart = arrEl(1): Exit For
End If
End If
Next El
FileName = arr(UBound(arr))
FoldPath = left(initName, InStrRev(initName, "\"))
fileNoExtention = Split(FileName, ".")(0)
newFileName = NumPart & "_" & fileNoExtention & strExtension
changeFileName = FoldPath & newFileName
End Function
Его можно протестировать с помощью следующего тестового подпрограммы:
Sub testChangeFileName()
Dim initName As String, finalName As String
initName = "C:\Users\User\Folder1\Folder2\Folder3\Folder4\ABC_5438_QWER\Folder5\Folder6\Folder7\Filename.SLDPPRT"
Const strExtension As String = ".STEP" 'dot included...
Debug.Print "Init Name = " & initName
finalName = changeFileName(initName, strExtension) 'use it as you need...
Debug.Print "New Name = " & finalName
End Sub
Я использовал шаблон, описанный в комментарии ниже.
Пожалуйста, оставьте отзыв после тестирования.
@JetskiS Разве вы не нашли время протестировать предложенное выше решение? Если проверить, не сделал ли он то, что вам нужно?
Привет @FaneDuru Спасибо за ответ. Я только начал заново. Ваш сценарий работает, но это не совсем то, что я имел в виду. Моя вина, я должен быть яснее. Или я не могу найти, где в вашем скрипте используется код XXX_0000_XXXX. Я переписал свой вопрос. Надеюсь, теперь стало яснее. Я пойму, если я утомил тебя и ты закончил мне помогать. :) В обоих случаях я хочу еще раз поблагодарить вас за усилия.
@JetskiS Это выглядит иначе, чем то, что я понял из вашего первоначального вопроса. Теперь для пути «C:\Users\User\Folder1\Folder2\Folder3\Folder4\ABC_5438_QWER\Folder5\Folder6\Folder7\Filename.SLDPPRT», возвращая «C:\Users\User\Folder1» \Folder2\Folder3\Folder4\ABC_5438_QWER\Folder5\Folder6\Folder7\5438_Filename.STEP" будет ли это правильным пониманием того, что вам нужно?
Да вы правы! Номера всегда разные и папка XXX_0000_XXXX не всегда находится по этому адресу. Это также может быть, например, расположение папки3 или папки6.
Хорошо, я адаптирую вышеуказанную функцию через минуту... Адаптировано.
Конечно, это творит чудеса. Это именно то, что я имел в виду. Я просто ошеломлен тем, как быстро вам удалось это исправить. Огромное спасибо @FaneDuru!
Всегда ли рисунок такой, как вы показываете? Я имею в виду, отделена ли часть фамилии символом подчеркивания (
_)?