VBA / Excel - chemin de découverte pour enregistrer un fichier, mais seulement correspondre à une certaine partie du chemin

Question

Je voudrais enregistrer un fichier dans le dossier exemple suivant:

C:\MainFolder\Subfolder1\Subfolder2\Subfolder3_A_abc_123

Il y a d'autres sous-dossiers dans le dossier dans lequel je voudrais le fichier est enregistré, comme:

Subfolder_B_xyz_456

Subfolder_C_rst_789

etc

La chose est que je veux trouver un dossier sur le le chemin tout le chemin jusqu'à: « Subfolder3_ », « A » sera récupéré à partir d'une plage dans une feuille et la « _abc_123 », je ne veux pas correspondre.

Quelqu'un at-il un exemple intelligent FSO ou autre sollution créatif? Je suis nouveau à la programmation de sorte que toute suggestion est appréciée.

Merci à l'avance.

PythonStyle

---

question Mise à jour à HO1:

Voici le 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

Je reçois une erreur sur cette ligne:

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

Pourriez-vous un coup d'oeil? Les noms des dossiers et classeurs sont modifiés de sorte qu'ils ne pourraient pas de sens. Seule la partie du dossier est important.

Merci à l'avance.

Mfg

P

Answer 1

Vous pouvez tout simplement boucle à travers tous les sous-répertoires et pour chaque répertoire que vous comparez avec le chemin que vous voulez trouver. Quelque chose comme ce code pseudo devrait fonctionner:

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 autre, similaire, option serait d'utiliser des expressions régulières qui sont plus puissants que Like, mais je ne pense pas que vous auriez besoin de cela. Cependant, juste au cas où, vous trouverez des informations à ce sujet ici: Comment utiliser des expressions régulières dans Visual Basic

Answer 2

Rien de mal à la solution ci-dessous. Je pensais juste que je voudrais aussi poster une autre alternative en utilisant la fonction Dir(), qui devrait être un peu plus vite - surtout si vous avez beaucoup de sous-répertoires de recherche.

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