Discussion :

[Tho69]

Bonjour,

Voici une partie de Sub qui appelle une Function:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

If ChercheEtOuvreFichierDepuis(CStr(FoldersSource(di)) & subfolder & "\" & FileSource & ".xlsx", subfolder) Then

Voici une partie de la Function appelée:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Private Function ChercheEtOuvreFichierDepuis(Fichier As String, subfolder As String) As Boolean
FoundFile = Dir(Fichier)

Et je voudrais que FoundFile = Dir(Fichier) fonctionne même s'il y a n'importe quelle chaine de caractère à cette endroit:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

If ChercheEtOuvreFichierDepuis(CStr(FoldersSource(di)) & subfolder & ICI & "\" & FileSource & ".xlsx", subfolder) Then

Je doute que cela aide mais je le précise au cas où: subfolder=une saisie dans une TextBox.
J'ai cherché du côté de la fonction Like, sans grand succès, je pense qu'il doit exister quelquechose de très simple pour rendre le chemin en partie aléatoire (comme le * de la fonction Like) mais j'ai du mal à poser des mots précis sur cette recherche donc les résultats ne sont pas ceux souhaités.
Si vous avez la moindre suggestion, je suis tout ouïe.
Merci.

Thomas

[Philippe Tulliez]

Bonjour,
J'avoue ne pas bien comprendre.
Un chemin aléatoire serait un chemin pris au hasard et je doute que ce soit cela que tu cherches.
Ne parles-tu pas plutôt d'un chemin paramétré ?
Soit une ouverture ou une recherche de fichier dans un répertoire dont le nom serait passé par paramètre ou argument ce qui revient au même.

[Tho69]

Bonjour et merci Philippe.

Ce que je veux c'est que si ma saisie, donc subfolder, est "STR0123". La fonction: ChercheEtOuvreFichierDepuis(CStr(FoldersSource(di)) & subfolder & "\" & FileSource & ".xlsx", subfolder) s'exécute même si le dossier subfolder est par exemple: "STR0123 XYZ01 ..."

[parmi]

Sans être certain de bien comprendre, peut-être que tu devrais mettre 3 paramètres à ta Function: Chemin de base, Sous-dossier contenant le fichier et le fichier lui-même

Par contre, le sous-répertoire devra être un répertoire existant, autrement tu vas chercher n'importe quoi...

Autre possibilité serait de faire une Function récursive pour rechercher tous les répertoires commençant par "STR0123", disons, et y faire une recherche du fichier demandé...

[mercatog]

Utilise le joker *

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

FoundFile = Dir(Fichier & "*")

[Tho69]

Bonjour et merci parmi et mercatog,

Sans être certain de bien comprendre, peut-être que tu devrais mettre 3 paramètres à ta Function: Chemin de base, Sous-dossier contenant le fichier et le fichier lui-même

C'est ce qui est fait parmi. Sauf que ça fonctionne quand le nom du sous-dossier=subfolder=TextBox2.Text. Et je voudrais que ça fonctionne si le nom du sous-dossier contient TextBox2.Text mais peut contenir d'autres caractères supplémentaires.

Utilise le joker *

J'ai essayé mercatog mais comme tu vas le comprendre en voyant la Sub et la Function, ce n'est pas aussi évident que ça (enfin pour moi du moins )

Pour une meilleur compréhension voici la Sub:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
Private Sub TextBox1_Change()
 
Application.DisplayAlerts = False
 
    Const FileSource As String = "Sport"
 
    Dim wkbSrce As Workbook
    Dim last As Long
    Dim FoldersSource As Variant
    Dim subfolder As String
 
    subfolder = TextBox1.Text 'La saisie dans la zone de saisie est appelée "subfolder"
 
    If subfolder Like "STR####" Then
        FoldersSource = Array("C:\Users\105063782\Desktop\Réseau test\TDSK\TV\", "C:\Users\105063782\Desktop\Réseau test\TDSA\TV\")
    End If
    If subfolder Like "SCR####" Then
        FoldersSource = Array("C:\Users\105063782\Desktop\Réseau test\TDSK\CC\", "C:\Users\105063782\Desktop\Réseau test\TDSA\CC\")
    End If
 
    If Not IsEmpty(FoldersSource) Then
        Dim di As Integer
        For di = 0 To UBound(FoldersSource)
            If ChercheEtOuvreFichierDepuis(CStr(FoldersSource(di)) & subfolder & "\" & FileSource & ".xlsx", subfolder) Then
                Exit For 'fichier trouvé
            End If
        Next di
    End If
 
Application.DisplayAlerts = True
 
End Sub

Et voici la Function appelée par la sub:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
Private Function ChercheEtOuvreFichierDepuis(Fichier As String, subfolder As String) As Boolean
 
    Dim wkbSrce As Workbook
    Dim last As Integer
    Dim FoundFile As String
 
    ChercheEtOuvreFichierDepuis = False
 
    FoundFile = Dir(Fichier)
 
    Do While FoundFile <> ""
 
        If FoundFile <> "" Then
 
            Application.ScreenUpdating = False
 
            Set wkbSrce = Application.Workbooks.Open(Fichier)
 
            last = ThisWorkbook.Worksheets.Count
            wkbSrce.Sheets(1).Copy after:=ThisWorkbook.Sheets(last)
 
            Application.DisplayAlerts = False
            ThisWorkbook.Sheets(last).Delete
            Application.DisplayAlerts = True
 
            ThisWorkbook.Sheets(last).Name = subfolder
 
            wkbSrce.Close
 
            Set wkbSrce = Nothing
 
            Hide
 
            Application.ScreenUpdating = True
            ChercheEtOuvreFichierDepuis = True
 
            Exit Do
 
        End If
 
        FoundFile = Dir
 
    Loop
 
End Function

J'ai d'abord pensé à une solution dans le style de celle de mercatog mais je n'arrive pas à l'appliquer. Je ne comprend pas pourquoi quand je remplace la ligne 24 de ma Sub par:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

If ChercheEtOuvreFichierDepuis(CStr(FoldersSource(di)) & subfolder & "*" & "\" & FileSource & ".xlsx", subfolder & "*") Then

Le message d'erreur Erreur d'exécution '52': Nom ou numéro de fichier incorrect s'affiche et la ligne 9 de la Function est surlignée.

Si vous avez la moindre suggestion...

Merci encore.

[clementmarcotte]

Bonjour,

Je ne dirai pas que j'ai tout lu, mais, à ma connaissance, en VB6 - VBA, toutes les fonctions de recherche de noms de fichiers/dossiers nécessitent le nom exact du dossier. Tu dois trouver le nom exact du dossier avant de rechercher des fichiers dans le dossier en question.

À première vue, tu pourrais rechercher les sous-dossiers du dernier dossier dont tu es sur qu'il a le bon nom. (Je ne l'ai pas en mémoire, mais, il y a un paramètre de la fonction Dir() qui permet de ne récupérer que dossiers. Une fois que tu as validé le nom du dossier, là tu peux rechercher les fichiers du dossier, et pas avant.

Je dirais que si tu retrouves tarte dans ton Textbox et que tu veux que tarte soit équivalent à tartempion, tu peux utiliser Instr() pour voir si ton nom de fichier contient tarte et valider si le dossier qui contient tarte dans son nom est vraiment le bon. Parce que, si tu as un sous-dossier Tartemnpion et un sous-dossier tartelette, il faut que tu trouves quelle "tarte" est la bonne.

Ou bien, tu trouves ta liste des dossiers présents, et tu la mets dans un Listbox et ton utilisateur travaille à partir du ListBox, au lieu du TextBox.

Et tout cela en espérant que j'ai bien compris...

[mercatog]

Non, le joker ne peut fonctionner ainsi pour avoir le sous répertoire.
Pour cela, il faudra parcourir tous les sous répertoires qui commencent par ton mot

Exemple

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
Private Sub TextBox1_Change()
Const FileSource As String = "Sport"
Dim FoldersSource As Variant
Dim SubFolder As String
Dim i As Integer
 
Application.DisplayAlerts = False
SubFolder = TextBox1.Text                          'La saisie dans la zone de saisie est appelée "subfolder"
 
If SubFolder Like "STR####" Then
    FoldersSource = Array("C:\Users\105063782\Desktop\Réseau test\TDSK\TV\", "C:\Users\105063782\Desktop\Réseau test\TDSA\TV\")
ElseIf SubFolder Like "SCR####" Then
    FoldersSource = Array("C:\Users\105063782\Desktop\Réseau test\TDSK\CC\", "C:\Users\105063782\Desktop\Réseau test\TDSA\CC\")
Else
    Exit Sub
End If
 
For i = 0 To UBound(FoldersSource)
    If Importer(FoldersSource(i), SubFolder, FileSource & ".xlsx") Then
        Exit For                                   'fichier trouvé
    End If
Next i
End Sub
 
Private Function Importer(ByVal Rep As String, ByVal SousRep As String, ByVal Fichier As String) As Boolean
Dim FichTrouve As String, SubFolder As String
Dim WkbSrce As Workbook
Dim Last As Integer
 
 
Application.ScreenUpdating = False
SubFolder = FindSubFolder(Rep, SousRep)
If SubFolder <> "" Then
    FichTrouve = Dir(SubFolder & "\" & Fichier)
 
    If FichTrouve <> "" Then
        Importer = True
        Do While FichTrouve <> ""
            Set WkbSrce = Application.Workbooks.Open(SubFolder & "\" & Fichier)
            Last = ThisWorkbook.Worksheets.Count
            WkbSrce.Worksheets(1).Copy After:=ThisWorkbook.Worksheets(Last)
 
            Application.DisplayAlerts = False
            ThisWorkbook.Worksheets(Last).Delete
            Application.DisplayAlerts = True
 
            ThisWorkbook.Worksheets(Last).Name = Replace(SubFolder, Rep, "")
 
            WkbSrce.Close False
            Set WkbSrce = Nothing
            FichTrouve = Dir()
        Loop
    End If
End If
End Function
 
'On cherche le sous répertoire
Private Function FindSubFolder(ByVal Folder As String, Begin As String) As String
Dim Tmp As String
 
ChDrive "C:\"
ChDir Folder
Tmp = Dir(Begin & "*", vbDirectory)
If Tmp <> "" Then FindSubFolder = Folder & Tmp
End Function

[Tho69]

Un grand MERCI à tous pour tant de réactivité, de connaissances et d'idées partagées!

Le code de mercatog fonctionne donc cette discussion est close. Je vais prendre le temps d'analyser , de comprendre et apprendre vos différentes idées.

En attendant je vous souhaite une bonne continuation.

Thomas

[parmi]

De là mon idée d'avoir 3 paramètres (Dossier, Sous-Dossier et Fichier)

C'est plus facile ainsi à décortiquer...
Bonne continuation à toi aussi !