Select value from path to save file using VBA

Question

I wrote a script using VBA to save a Solidworks part in my opened assembly as step file, in a specific folder. This works fine for me. Here is my entire code.

'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

However, I want to use a part of the part's path in the new file name. The path of the part looks like this:

C:\Users\User\Folder1\Folder2\Folder3\Folder4\XXX_0000_XXXX\Folder5\Folder6\Folder7\Filename.SLDPPRT

I want to rename the file, using a part of the original path, namely the following folder: XXX_0000_XXXX, where X=letter, 0=number. For every new file, this code is different. It can for example be ABC_0102_DEFG or YGS_1842_GEHV. I want to include ONLY the numbers in the filename.

Currently, this is an example of the input: "FilenameOld.SLDPRT" and the output: "FilenameNew.STEP". The desired output should be something like "0000_FilenameNew.STEP". In my code, this number is 'ProjectNr' with a set value. This value should be taken out of the path. Additional example:

C:\Users\User\Folder1\Folder2\Folder3\Folder4\XYZ_7619_QWER\Folder5\Folder6\Folder7\7619_Filename.STEP.

The pathname is already given/generated. So the number in the code XXX_0000_XXXX is known. To make it more difficult, the code is not always on the same location. It can be positioned between Folder4-Folder5, but can also be placed between e.g. Folder3-Folder4. Can somebody please help me?

Please don't hesitate to ask any questions. Thank you in advance!

Answer 1

Please, use the next function:

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

It can be tested using the next testing Sub:

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

I used the pattern discussed in the bellow comment.

Please, send some feedback after testing it.