[XL-2003] selectionner un dossier et l'utiliser avec LookIn

[hidodu]

Bonjour a tous
J'ai un petit problème avec une macro. Je cherche à extraire dans une feuille excel tous les titres des fichiers contenus dans un dossier. Le problème est que jusqu'à présent, lorsque j'arrive à sélectionner le dossier, il ne me détecte plus aucun fichier à l'intérieur. J'ai l’impression que c'est une question de syntaxe au niveau du LookIn (ligne 30).
Un conseil?

Merci d'avance

Voici mon code :

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
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
 Sub Macro1()
'
' Macro1 Macro
' Macro enregistrée le 18/01/2011 par Beatriz
'
 
'
Windows("titre décalage tpsO2  3sur4.xls").Activate
Sheets("extraction noms fichiers").Select
Range("A1").Activate
 
 
    Dim fd As FileDialog
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)
    Dim vrtSelectedItem As Variant
    With fd
        .AllowMultiSelect = True
        If .Show = -1 Then
            For Each vrtSelectedItem In .SelectedItems
                MsgBox vrtSelectedItem
            Next
        Else
        End If
    End With
 
    Set fd = Nothing
 
Set fichcherche = Application.FileSearch
With fichcherche
    .LookIn = vrtSelectedItem
    .Filename = "*.oew"
    If .Execute > 0 Then
    For I = 1 To .FoundFiles.Count
            Workbooks.OpenText Filename:=.FoundFiles(I), Origin _
        :=xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
        xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=True, _
        Comma:=True, Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), _
        Array(2, 1), Array(3, 1), Array(4, 1)), TrailingMinusNumbers:=True
 
 
 
        Set toto = ActiveSheet
        Windows("titre décalage tpsO2  3sur4.xls").Activate
        ActiveCell.Offset(rowOffset:=1, columnOffset:=0).Activate
        ActiveCell = toto.Name
        Application.CutCopyMode = False
        toto.Activate
        ActiveWindow.Close
 
 
    Next I
    Else
        MsgBox "Aucun fichier .oew n'a été trouvé."
    End If
 
End With
 
 
    MsgBox "Finiiii"
 
End Sub

[hidodu]

bump!