VBA/Excel - chemin trouver pour enregistrer un fichier, mais correspondent à 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 existe d'autres sous-dossiers dans le dossier où je voudrais que le fichier est enregistré, comme:

Subfolder_B_xyz_456

Subfolder_C_rst_789

etcLe fait est que je veux trouver un dossier sur le chemin jusqu'à: "Subfolder3_", le "A" sera récupéré à partir d'une plage dans une feuille et le "_abc_123", je ne sais pas vouloir correspondre.

Est-ce que quelqu'un a un exemple de FSO intelligent ou une autre solution créative? Je suis nouveau à la programmation donc toute suggestion est appréciée.

Merci d'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 & "*") 

Pouvez-vous s'il vous plaît avoir un Regarde ça? Les noms des dossiers et des classeurs ont été modifiés afin de ne pas avoir de sens. Seule la partie dossier est importante.

Merci d'avance.

Mfg

P

Answer 1

Vous pourriez juste 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 pouvez trouver des informations à ce sujet ici: How to Use Regular Expressions in Visual Basic

Answer 2

Rien à redire avec la solution affichée. Je pensais juste que je publierais aussi une autre alternative en utilisant la fonction Dir(), qui devrait être un peu plus rapide - surtout si vous avez beaucoup de sous-répertoires à rechercher.

à savoir

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