[E07] get open filename

Version imprimable

Bonjour tout le monde. je bloque sur l'adaptation de getopenfilename que j'utilisais pour designer un repertoire et y ouvrir et fermer successivement tout les fichiers qu'il contiens
mon code

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
 
Dim stFichier
 stFichier = Application.GetOpenFilename
   With Application.FileSearch
   .NewSearch
   .LookIn = cheminbalance(stFichier)
   .Execute
    On Error Resume Next
    ScreenUpdating = False
      For Each f In .FoundFiles
      Workbooks.Open f
.....traitement
ActiveWorkbook.Close True
Next f

j'ai trouvé dans la faq :
pour selectionner un dossier

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
 
Sub Utilisation_FileDialog_SelectionDossier()
    Dim x As Long
 
    With Application.FileDialog(msoFileDialogFolderPicker)
        'Définit un titre pour la boîte de dialogue
        .Title = "Le tite de la fenêtre:"
        'Affiche la boîte de dialogue
        .Show
 
        'Affiche le nom du dossier sélectionné
        If .SelectedItems.Count > 0 Then
            MsgBox .SelectedItems(1)
        End If
 
    End With
End Sub

mais je n'arrive pas faire ouvrir les fichiers qu'il contient
j'ai trouvé aussi

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
 
Sub ChoixRepertoire()
   Dim objShell As Object, objFolder As Object, oFolderItem As Object
    Dim Chemin As String
 
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)
 
    On Error Resume Next
    Set oFolderItem = objFolder.Items.Item
    Chemin = oFolderItem.Path
 
    MsgBox Chemin
End Sub

mais j'ai le même soucis
le plus proche est encore

Code:

1
2
3
4
5
6
7
8
9
10
11
 
Sub ouverture()
Filename = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls), *.xls", Title:="Selectionnez un fichier")
    If Filename = False Then
        ' They pressed Cancel
        MsgBox "Arret de la procédure , car vous n'avez pas choisi de fichier"
        Exit Sub
    Else
        Workbooks.Open (Filename)
        End If
End Sub

mais là; il faut designer tout les fichiers (selection multiple, et comme l'utilisateur ne le sait pas, risque de cafouillage)
donc, je suis un peu perdu, un peu d'aide bienvenue
cerise sur le gateau, si ça pouvait fonctionner indiferement sur 2007 et avant, ça serait vachement bien ;)
merci

Tu aurais meilleur temps à utiliser Dir. Pas de déclaration inutile et efficacité garantie quand tu connais le répertoire

Code:

1
2
3
4
5
6
7
8
9
10
Sub Test()
Dim chemin As String, NomFich As String
    chemin = "D:\LeRep\"
    NomFich = Dir(chemin, vbNormal)
    Do While NomFich <> ""
        Workbooks.Open chemin & NomFich
        DoEvents
        NomFich = Dir()
    Loop
End Sub

08/04/2008, 18h49
alsimbad

oui, merci, le conseil est bon, mais ne me conviens pas. il y a une premiere phase de traitement humain ou les fichiers vont etre mis en ordre par repertoire, les noms peuvent donc varier , paris Paris lyons, les villes changent, bref, c'est le brin. et ensuite l'operateur peut decider de faire telle ou telle ville suivant l'humeur ou le temps dont il dispose. donc le getopen... est le mieux pour mon cas

Salut, sans doute à adapter, les fichiers se trouvent dans Coll

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
'-------------------------------------------------------
'
'   Outils/Références Cocher Microsoft Scripting Runtime
'
'-------------------------------------------------------
 
Option Explicit
Dim Coll As Collection
Const TypeFichier As String = "FF_## ## ####.xls"
 
Sub SelectionDossier()
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = ThisWorkbook.Path & "\"
        .Title = "Sélectionner le Dossier contenant les fichiers à traiter"
        .AllowMultiSelect = False
        .InitialView = msoFileDialogViewDetails
        .ButtonName = "Sélection Dossier"
        .Show
        If .SelectedItems.Count > 0 Then
            Liste .SelectedItems(1)
        End If
    End With
End Sub
 
Private Sub Liste(ByVal sChemin As String)
    Set Coll = New Collection
    ListeFichiers sChemin, Coll, False
    ....
    Set Coll = Nothing
End Sub
 
Private Sub ListeFichiers(ByVal sChemin As String, ByVal Coll As Collection, ByVal Recursif As Boolean)
Dim FSO As Scripting.FileSystemObject
Dim Dossier As Scripting.Folder
Dim SousDossier As Scripting.Folder
Dim Fichier As Scripting.File
 
    Set FSO = New Scripting.FileSystemObject
    Set Dossier = FSO.GetFolder(sChemin)
 
    For Each Fichier In Dossier.Files
        If UCase(Fichier.Name) Like UCase(TypeFichier) Then
            Coll.Add Fichier.Path
        End If
    Next Fichier
 
    If Recursif Then
        For Each SousDossier In Dossier.SubFolders
            ListeFichiers SousDossier.Path, Coll, True
        Next SousDossier
    End If
 
    Set FSO = Nothing
End Sub

08/04/2008, 19h28
ucfoutu

Bonjour,

A voir, selon les réponses que tu vas apporter ici :

Tes fichiers à ouvrir sont-ils tous dans le même dossier ?
- Si oui : ton appli connait-elle le chemin de ce dossier ?
- si ton appli ne connait pas ce chemin de dossier, ce dossier se trouve-t-il au moins dans le répertoire de l'Appli (parmi d'autres et il faut alors choisir le dossier) ?
- l'utilisateur doit-il pouvoir faire une sélection multiple (donc de plusieurs fichiers à ouvrir) ?

En fonction de tes réponses, je pourrais peut-être imaginer du sur mesure.
08/04/2008, 19h34
ouskel'n'or

Citation:

Envoyé par alsimbad

oui, merci, le conseil est bon, mais ne me conviens pas. il y a une premiere phase de traitement humain ou les fichiers vont etre mis en ordre par repertoire, les noms peuvent donc varier , paris Paris lyons, les villes changent, bref, c'est le brin. et ensuite l'operateur peut decider de faire telle ou telle ville suivant l'humeur ou le temps dont il dispose. donc le getopen... est le mieux pour mon cas

Ce n'est pas un problème. Le nom des villes peut bien varier, si tu listes TOUS les fichiers d'un répertoire, tu les auras tous.
Pour sélectionner un fichier, tu as les boîtes de dialogue intégrées d'Excel, plus rapides et plus simples que fso. Une ligne suffit !

Code:

Application.Dialogs.Item(xlDialogOpen).Show

Pour te placer dans le bon répertoire, c'est

Code:

ChDir "D:\TonRep"

Si ton répertoire est dans un autre lecteur, tu mets avant

Code:

chdrive "d"

Pour moi, fso est une charrue qui occupe de la place pour rien.
Il n'y a que lorsque tu veux lister un répertoire et son/ses sous-répertoires que ça se justifie.
C'est toi qui vois s'il est utile d'ajouter 10 lignes de code ;)
08/04/2008, 20h53
alsimbad

d'abord pour ucfoutu

Citation:

Envoyé par ucfoutu

Tes fichiers à ouvrir sont-ils tous dans le même dossier ?

Citation:

Envoyé par alsimbad

j'utilisais pour designer un repertoire et y ouvrir et fermer successivement tout les fichiers qu'il contiens

- Si oui : ton appli connait-elle le chemin de ce dossier ?
getopenfilename est là pour lui montrer le chemin

- si ton appli ne connait pas ce chemin de dossier, ce dossier se trouve-t-il au moins dans le répertoire de l'Appli (parmi d'autres et il faut alors choisir le dossier) ?
il peut etre n'importe ou

- l'utilisateur doit-il pouvoir faire une sélection multiple (donc de plusieurs fichiers à ouvrir) ?
je veux qu'il ne designe que le repertoire, l'appli ouvre tout les fichiers excel qu'il contient

En fonction de tes réponses, je pourrais peut-être imaginer du sur mesure.
yes, moove your brain for me :D please et merci

pour ouskel'nor
la boite integrée d'excel me conviens tres bien, mais je ne sais pas en sortir la désignation des fichier qu'elle contient
extraire ce qu'elle contient et lui dire d'ouvrir les fichier
F = les trois fichiers de ce repertoire ( ou bien pour chaqque fichier de ce repertoire)
ouvre le premier
traitement
ferme
ouvre le suivant

du moins je ne sais pas faire avec 2007

pour kiki 29
Yec’hed mat
je vais tester ce que tu me dis, je dirais aprés

bonne soirée a tous
08/04/2008, 21h59
ouskel'n'or

Tu as peut-être la solution ici
Teste le fichier, tu peux faire tout ce que tu demandes et beaucoup plus.

J'utilise à la fso et dir pour une question de rapidité, mais aucune référence n'a besoin d'être validée.

Starec dit que la procédure n'ouvre pas les fichiers sous VBA 2007 mais je ne pense pas qu'il s'agise des classeurs. Ça reste à tester.
Que le code pour ouvrir un classeur ait changé entre 2003 et 2007 m'étonnerait beaucoup.

Bref, tu lis les explications, tu testes.
On pourra toujours adapter.
Tu dis
A+
09/04/2008, 05h56
alsimbad
merci ouskel, mais là c'est pas assez simple. si tu fais tourner mon code, tu verra que c'est ultrasimple. la boite de dialogue ouvrir apparait, on designe le repertoire, et hop, ça tourne. la personne sait ou elle a mis les fichiers. quand je disais paris ou lyon, ce sont les dossier qu'elle crée au départ. et l'appli traite tout les fichiers a l'interieur du dossier.
pour kiki29
la boite est la bonne mais pour la designation des fichiers, ça ne marche pas. pour ces 4 lignes, j'ai l'erreur type defini par l'utilisateur non defini
Code:

1 2 3 4 Dim FSO As Scripting.FileSystemObject Dim Dossier As Scripting.Folder Dim SousDossier As Scripting.Folder Dim Fichier As Scripting.File
09/04/2008, 06h26
AlainTech

Je n'ai pas tout lu mais, pour ma part, j'utilise toujours

Code:

Set fdOpen = Application.FileDialog(msoFileDialogOpen)

pour ouvrir un fichier.

Pour accéder à un dossier,

Code:

Application.FileDialog(msoFileDialogFolderPicker)

me semble être la méthode la plus appropriée.
09/04/2008, 06h45
kiki29
Salut, au lieu de faire de l'Early Binding,fais du Late Binding ( Liaison Précoce/Tardive)
Code:

1 2 3 4 5 6 Dim FSO As Object Dim Dossier As Object Dim SousDossier As Object Dim Fichier As Object Set FSO = CreateObject("Scripting.FileSystemObject")
sinon il fallait lire la toute 1ere ligne ...

Code:

Cocher Microsoft Scripting Runtime

D'autre part il faudra insérer le traitement dans
Code:

1 2 3 4 5 6 Private Sub Liste(ByVal sChemin As String) Set Coll = New Collection ListeFichiers sChemin, Coll, False .... Set Coll = Nothing End Sub
Avec

Code:

For i=1 to Coll.Count

pour accéder aux fichiers TypeFichier

et eventuellement basculer de False à True,pour balayer Dossiers/Sous Dossiers

Code:

ListeFichiers sChemin, Coll, False

Pour 2007 rajouter un DoEvents
Code:

1 2 3 4 If .SelectedItems.Count > 0 Then DoEvents Liste .SelectedItems(1) End If

Je mets trois méthodes pour lister les fichiers d'un répertoire afin de comparer le temps d'exécution pour chacune d'elles

Comme AlainTech, j'utilise

Citation:

Set fd = Application.FileDialog(msoFileDialogFilePicker)

pour sélectionner un répertoire (pas nécessairement pour sélectionner un fichier)

La troisième méthode nécessite de valider la référence "Microsoft Scripting Runtime"

Pour effectuer le test, exécuter la procédure SelectionDuRépertoire()

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
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
Public Declare Function GetTickCount& Lib "kernel32" ()
 
Sub SelectionDuRepertoire()
Dim fd As FileDialog, NC As Variant, Chemin As String
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
        If .Show = -1 Then
            For Each NC In .SelectedItems
                Chemin = Left(NC, Len(NC) - InStr(StrReverse(NC), "\"))
            Next
            Else
            MsgBox "Chemin non trouvé"
            Exit Sub
        End If
    End With
    ListerUnRepertoireAvecDir Chemin
    ListerUnRepertoireAvecFileSearch Chemin
    ListerUnRepertoireAvecFso Chemin
End Sub
 
'Public Declare Function GetTickCount& Lib "kernel32" ()
Sub TempsEcoulé(NbF As Integer, duree As Double, NomSub As String)
Dim mn As Integer, ms As Integer, sd As Integer, tps As String
    mn = Int(duree / 1000 / 60)
    sd = Int((duree / 1000) - (mn * 60))
    ms = duree - (sd * 1000) - (mn * 1000 * 60)
    tps = mn & " mn " & sd & " s " & ms & " millisecondes"
    MsgBox "Procédure " & NomSub & vbCr & "Nombre de fichiers du répertoire " & NbF & vbCr & _
    "Temps écoulé : " & tps
End Sub
 
Sub ListerUnRepertoireAvecFileSearch(Chemin As String)
Dim fs As Variant
Dim tablo()
Dim Depart As Double, duree As Double
    Depart = GetTickCount&
    Set fs = Application.FileSearch
    With fs
        .LookIn = Chemin
        .FileType = msoFileTypeExcelWorkbooks
        If .Execute(SortBy:=msoSortByFileName, _
            SortOrder:=msoSortOrderAscending) > 0 Then
            For i = 1 To .FoundFiles.Count
                'Workbooks.Open NomFich
                ReDim Preserve tablo(i)
                tablo(i) = .FoundFiles(i)
            Next i
        End If
    End With
    duree = GetTickCount& - Depart
Dim NomSub As String
    NomSub = "ListerUnRepertoireAvecFileSearch"
    TempsEcoulé UBound(tablo), duree, NomSub
End Sub
 
Sub ListerUnRepertoireAvecDir(Chemin As String)
Dim NomFich As String, tablo()
Dim Depart As Double, duree As Double
    Depart = GetTickCount&
    NomFich = Dir(Chemin & "\", vbNormal)
    Do While NomFich <> ""
        'Workbooks.Open chemin & NomFich
        'DoEvents
        i = i + 1
        ReDim Preserve tablo(i)
        tablo(i) = Chemin & NomFich
        NomFich = Dir()
    Loop
    duree = GetTickCount& - Depart
Dim NomSub As String
    NomSub = "ListerUnRepertoireAvecDir"
    TempsEcoulé UBound(tablo), duree, NomSub
End Sub
 
Sub ListerUnRepertoireAvecFso(Chemin As String)
On Error Resume Next
Dim FSO As Scripting.FileSystemObject
    If Err <> 0 Then
        MsgBox "Nécessite la validation de la référence " & vbCr & _
        "Microsoft Scripting Runtime"
        Exit Sub
    End If
Dim Rep As Scripting.Folder
Dim Fich As Scripting.File
Dim tablo()
Dim Depart As Double, duree As Double
    Depart = GetTickCount&
    Set FSO = New Scripting.FileSystemObject
    Set Rep = FSO.GetFolder(Chemin)
 
    For Each Fich In Rep.Files
        If Right(Fich.Name, 4) = ".xls" Then
            'Workbooks.Open chemin & NomFich
            'DoEvents
            i = i + 1
            ReDim Preserve tablo(i)
            tablo(i) = Fich.Name
        End If
    Next
    duree = GetTickCount& - Depart
Dim NomSub As String
    NomSub = "ListerUnRepertoireAvecFso"
    TempsEcoulé UBound(tablo), duree, NomSub
End Sub

Voilà, tu peux comparer.
A toi de jouer

ça va, j'ai trouvé mon bonheur en modifiant le code d'ouskel

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
 
Sub SelectionDuRepertoire()
Dim fd As FileDialog, NC As Variant, Chemin As String
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
        If .Show = -1 Then
            For Each NC In .SelectedItems
                Chemin = Left(NC, Len(NC) - InStr(StrReverse(NC), "\")) & "\"
                NomFich = Dir(Chemin & "\", vbNormal)
                    Do While NomFich <> ""
                       Workbooks.Open Chemin & NomFich
                       MsgBox Range("g9").Value ' simili traitement
                       ActiveWorkbook.Close
                       NomFich = Dir()
                    Loop
            Next NC
        Else
            MsgBox "Chemin non trouvé"
            Exit Sub
        End If
    End With
 
End Sub

de cette façon, une fois le repertoire désigné, même si l'utilisateur ne clique que sur un seul fichiers, l'appli ouvre successivement tout les fichier du dossier et les traite
merci tout
milles excuses a kiki29 mais il me fallait plus de temps pour tester sa solution, je suis en limite de comprenette
merci a tout le monde

Un conseil ? Tant pis, je t'en donne un :mouarf:
Comme tu as un traitement entre Open.... et close (remplacé par ton msgbox que tu n'auras plus) et que tu vas ouvrir plusieurs fichiers à la suite, ajoute un doevents ici et là
Code:

1 2 3 4 5 Workbooks.Open Chemin & NomFich DoEvents ' simili traitement ActiveWorkbook.Close DoEvents
Juste en passant ;)