VBA / Excel - ruta hallazgo para guardar un archivo, pero sólo igualar una cierta parte del camino

Question

Me gustaría guardar un archivo en la carpeta siguiente ejemplo:

C:\MainFolder\Subfolder1\Subfolder2\Subfolder3_A_abc_123

Hay otras subcarpetas de la carpeta en la que me gustaría ser guardado el archivo, como:

Subfolder_B_xyz_456

Subfolder_C_rst_789

etc.

Lo que pasa es que yo quiero encontrar una carpeta en el el camino todo el camino hasta: "Subfolder3_", la "A" se va a recoger un rango en una hoja y el "_abc_123", no quiero para que coincida.

¿Alguien tiene un ejemplo FSO inteligente u otro sollution creativo? Soy nuevo en la programación por lo que cualquier sugerencia es apreciado.

Gracias de antemano.

PythonStyle

---

Actualización pregunta a HO1:

Este es el código:

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

Estoy consiguiendo error en esta línea:

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

¿Podría por favor eche un vistazo? Los nombres de las carpetas y cuadernos de trabajo se cambian por lo que podrían no tener ningún sentido. Sólo la parte de la carpeta es importante.

Gracias de antemano.

Rgds

P

Answer 1

Se podía recorrer todos los subdirectorios y para cada directorio se compara con la ruta que desea encontrar. Algo como esto pseudo código debería funcionar:

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

Un otras similares, una opción sería el uso de expresiones regulares que son más poderosos que Like, pero no creo que había necesidad de eso. Sin embargo, por si acaso, se puede encontrar información sobre ello aquí: Cómo utilizar expresiones regulares en Visual Basic

Answer 2

No hay nada malo con la solución publicados. Sólo pensé que también iba a publicar otra alternativa que utiliza la función Dir(), que debería ser un poco más rápido - especialmente si usted tiene una gran cantidad de subdirectorios a buscar.

es decir.

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