VBA/Excel - find path for saving a file, but only match a certain part of the path

Question

I'd like to save a file in the following example folder:

C:\MainFolder\Subfolder1\Subfolder2\Subfolder3_A_abc_123

There are other subfolders in the folder where I'd like the file be saved, like:

Subfolder_B_xyz_456

Subfolder_C_rst_789

etc

The thing is that I want to find a folder on the the path all the way up to: "Subfolder3_", the "A" will be fetched from a range in a sheet and the "_abc_123", I do not want to match.

Does anyone have a clever FSO example or other creative sollution? I'm new to programming so any suggestion is appreciated.

Thanks on advance.

PythonStyle

---

Updated question to ho1:

This is the code:

Sub Create_WorkB_Input()

Dim wbBook1 As Workbook
Dim wbBook2 As Workbook
Dim shTemp1 As Worksheet
Dim shTemp2 As Worksheet
Dim shTemp_admin As Worksheet
Dim shTSSR_inp1 As Worksheet
Dim shTSSR_inp2 As Worksheet
Dim strVersion As String
Dim strPrep As String
Dim Datecr As Date
Dim strComment As String
Dim intBatch As Integer
Dim strSiteID As String
Dim strClusterID As String
Dim strPath As String
Dim fso As New FileSystemObject
Dim flds As Folders
Dim f As Folder

Set wbBook1 = Workbooks("Name_Input_TEMPLATE_v4.0.xls")
Set wbBook2 = Workbooks("Name_Input_To_xxx.xlsm")
Set shTemp1 = Workbooks("Name_Input_TEMPLATE_v4.0.xls").Sheets("TSSR_Input_sh1")
Set shTemp2 = Workbooks("Name_Input_TEMPLATE_v4.0.xls").Sheets("TSSR_Input_sh2")
Set shTSSR_inp1 = Workbooks("Name_Input_To_xxx.xlsm").Sheets("xxx")
Set shTSSR_inp2 = Workbooks("Name_Input_To_xxx.xlsm").Sheets("yyy")
Set shTemp_admin = Workbooks("Name_Input_TEMPLATE_v4.0.xls").Sheets("www")

shTSSR_inp1.UsedRange.Copy

shTemp1.Paste

shTSSR_inp2.UsedRange.Copy

shTemp2.Paste

intBatch = shTemp1.Range("AQ2").Value
strSiteID = shTemp1.Range("A2").Value
strClusterID = shTemp1.Range("B2").Value
strComment = InputBox(Prompt:="Insert comments.", Title:="INSERT COMMENTS", Default:="New site - batch " & intBatch & " ref email fr Me dato")

With shTemp_admin
    .Range("A18").FormulaR1C1 = "4.0"
    .Range("B18").Value = "John Doe"
    .Range("C18").Value = Date
    .Range("D18").Value = strComment
End With

strPath = "D:\Path_to_folder\folder1\folder2\folder3\folder4"

Set flds = fso.GetFolder(strPath & "\Folder5_Input_Batch_" & intBatch & "*")

For Each f In flds


    If f.Name Like strPath Then



        wbBook1.SaveAs Filename:="" + strPath + "\" + "TSSR_Input_" + strClusterID + "_" + strSiteID + "_v4.0.xls", _
                FileFormat:=xlNormal, _
                Password:="", _
                WriteResPassword:="", _
                ReadOnlyRecommended:=False, _
                CreateBackup:=False

    End If

Next

End Sub

I am getting error at this line :

Set flds = fso.GetFolder(strPath & "\Folder5_Input_Batch_" & intBatch & "*")

Could you please have a look at it? The names of folders and workbooks are changed so they might not make any sense. Only the folder part is important.

Thanks in advance.

Rgds

P

Answer 1

You could just loop through all the subdirectories and for each directory you compare it with the path you want to find. Something like this pseudo code should work:

For each dir in SubDirectories
  Dim lookingFor as String
  lookingFor = "Subfolder3_" & yourVariable & "*"
  If dir.Name Like lookingFor Then ' Note the use of the Like operator here so that it sees the * as a wildcard
    ' This is the right one
  End If
Next

An other, similar, option would be to use regular expressions which are more powerful than Like, but I don't think you'd need that. However, just in case, you can find information about it here: How to Use Regular Expressions in Visual Basic

Answer 2

Nothing wrong with the posted solution. I just thought I would also post another alternative using the Dir() function, which should be a little faster - especially if you have a lot of subdirectories to search.

i.e.

Dim strFoundDir as String

strFoundDir=dir("C:\MainFolder\Subfolder1\Subfolder2\SubFolder3*" & SomeVariable & "*", vbDirectory)
    if lenb(strFoundDir)>0 then
        'Do the rest of your code
    end if