[XL-2003] Problème de renvoi de la valeur d'une fonction [Résolu]

[hallscar]

Bonjour à tous,
j'utilise la fonction ci-dessous, qui recherche un fichier dans les sous répertoires ou se trouve mon fichier excel. Les données d'entrée de la fonction sont:
- expression à rechercher (nom du fichier)
- racine à partir de laquelle commencer la recherche

La valeur que doit renvoyer la fonction est le chemin ou se trouve le fichier.

Code :

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
Function Explorer(p_strFichier As String, p_strCheminDepart As String, Optional p_oFld As Scripting.Folder) As String
    On Error GoTo err
 
    Dim oFSO As Scripting.FileSystemObject
    Dim oFld As Scripting.Folder
    Dim oFl As File
    Dim Chemin As String
    If p_oFld Is Nothing Then
        'Instanciation du FSO (déclare l'objet FSO (gestion des dossiers et fichiers))
        Set oFSO = New Scripting.FileSystemObject
        'Accède au répertoire du départ de recherche
        Set p_oFld = oFSO.GetFolder(p_strCheminDepart)
    End If
 
    Set oFl = p_oFld.Files(p_strFichier)
    MsgBox oFl.Path
    Explorer = oFl.Path
 
    Exit Function
 
SubDir:
    'Explore les sous-dossiers
    For Each oFld In p_oFld.SubFolders
        Explorer p_strFichier, p_strCheminDepart, oFld
        DoEvents
    Next oFld
 
fin:
    Exit Function
 
err:
    Select Case err.Number
        Case 53: Resume SubDir
        'Case Else:
        '    MsgBox "Erreur inconnue"
        '    Resume fin
    End Select
 
End Function

problème :
Une fois la fonction terminée, chemin est vide (renvoit : "")

cela semble venir de Exit Function (en mode pas à pas, je vois que c'est au moment ou exit function est exécuté que le renvoi de "explorer" se vide)

[Qwazerty]

Salut

Jéte un coup d'oeil ici .
[Edit] En fait je me rend compte que ça n'est pas pas vraiment compatible, mais du coup j'ai modifié le code de ma contribution suite à ce message, je laisse donc le lien.[/Edit]

J'ai quand même essayé ton code et je n'ai pas eu de soucis.
Je l'ai quand même modifié un peu

Code :

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
Function Explorer(p_strFichier As String, p_strCheminDepart As String, Optional p_oFld As Scripting.Folder) As String
On Error GoTo err
 
Dim oFSO As Scripting.FileSystemObject
Dim oFld As Scripting.Folder
Dim oFl As File
Dim Chemin As String
If p_oFld Is Nothing Then
'Instanciation du FSO (déclare l'objet FSO (gestion des dossiers et fichiers))
Set oFSO = New Scripting.FileSystemObject
'Accède au répertoire du départ de recherche
Set p_oFld = oFSO.GetFolder(p_strCheminDepart)
End If
 
'Inutil de faire une gestion d'erreur, l'erreur est potentiellement attendu
'Autant verifié une fois la ligne passé que tout c'est bien passé
On Error Resume Next
Set oFl = p_oFld.Files(p_strFichier)
On Error GoTo err
 
If Not oFl Is Nothing Then
    Explorer = oFl.Path
Else
    'Explore les sous-dossiers
    For Each oFld In p_oFld.SubFolders
        Explorer p_strFichier, p_strCheminDepart, oFld
        DoEvents
    Next oFld
End If
 
err:
If err.Number <> 0 Then
    Select Case err.Number
        Case 53: 'Resume SubDir 'devenu inutile puisque déjà géré dans le code
        Case Else:
            MsgBox "Erreur inconnue"
            'Resume fin 'il faut juste laisser le code se poursuivre
        End Select
End If
End Function
 
 
Sub test()
Dim Retour As String
Retour = Explorer("A sup.xlsx", "d:\")
End Sub

La vérification des sous répertoires en cas de recherche infructueuse est intéressant, je vais peut-être l'implémenté dans ma contribution.

++
Qwaz

[hallscar]

Cela fonctionne bien chez toi? car chez moi non

Code :

1
2
3
4
5
6
7
8
9
If Not oFl Is Nothing Then
    Explorer = oFl.Path
Else
    'Explore les sous-dossiers
    For Each oFld In p_oFld.SubFolders
        Explorer p_strFichier, p_strCheminDepart, oFld
        DoEvents
    Next oFld
End If

Explorer prend bien la valeur de oFl.Path, mais dans la suite du programme "DoEvents" est rééxécuté avant de finir la fonction, ce qui vide Explorer

[bbil]

bonjour,

j'ai du mal à comprendre la logique de ton programme .... mais à première vue dans ta boucle For Each ... tu as oublié de traiter le retour de ta fonction Explorer ... et en supposant que tu ne recherche qu'un seul fichier ... il faut que tu sorte de cette boucle au premier fichier trouvé ....

[Qwazerty]

Salut

Cela fonctionne bien chez toi? car chez moi non

Je me suis cantonné à un exemple simple avec le fichier dans le répértoire, juste pour voir ton histoire de variables qui se vident.

Sinonbbil à raison...

Essai ça

Code :

1
2
3
4
5
6
'Explore les sous-dossiers
    For Each oFld In p_oFld.SubFolders
        explorer = explorer(p_strFichier, p_strCheminDepart, oFld)
        If explorer <> "" Then Exit For
        DoEvents
    Next oFld

Par contre je ne comprend pas ton problème de contenu de variables qui se vident, remet le code que tu utilises.

++
Qwaz

[hallscar]

Merci de vos réponses, je viens de tester à l'instant le dernier code de Qwazerty, et ca fonctionne parfaitement

Code :

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
Function Explorer(p_strFichier As String, p_strCheminDepart As String, Optional p_oFld As Scripting.Folder) As String
Dim oFSO As Scripting.FileSystemObject
Dim oFld As Scripting.Folder
Dim oFl As File
Dim Chemin As String
If p_oFld Is Nothing Then
'Instanciation du FSO (déclare l'objet FSO (gestion des dossiers et fichiers))
Set oFSO = New Scripting.FileSystemObject
'Accède au répertoire du départ de recherche
Set p_oFld = oFSO.GetFolder(p_strCheminDepart)
End If
 
'Inutil de faire une gestion d'erreur, l'erreur est potentiellement attendu
'Autant verifié une fois la ligne passé que tout c'est bien passé
On Error Resume Next
Set oFl = p_oFld.Files(p_strFichier)
On Error GoTo err
 
If Not oFl Is Nothing Then
    Explorer = oFl.Path
Else
    'Explore les sous-dossiers
    For Each oFld In p_oFld.SubFolders
        Explorer = Explorer(p_strFichier, p_strCheminDepart, oFld)
        If Explorer <> "" Then Exit For
        DoEvents
    Next oFld
End If
 
err:
If err.Number <> 0 Then
    Select Case err.Number
        Case 53: 'Resume SubDir 'devenu inutile puisque déjà géré dans le code
        Case Else:
            MsgBox "Erreur inconnue"
            'Resume fin 'il faut juste laisser le code se poursuivre
        End Select
End If
End Function

Pour la logique du code, je n'en suis pas l'auteur... (j'ai moi meme du mal à comprendre)

@+