Discussion :

[HiT]

Bonjour, petit pb en vba... j ai un code qui me permet de creer un explorateur de fichier et de choisir un fichier et de mettre son chemin dans une textbox. Mais ce que je voudais faire, c'est un explorateur qui me permette de selectionner non pas un fichier, mais un repertoire(dossier).
Rnsuite savez vous comment parcourir les fichiers d'un repertoire.
Merci.

[argyronet]

Bonjour,

Il suffit d'exploiter l'API SHBrowseForFolder:

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
 
Private Type BrowseInfo
    hWndOwner As Long
    pIDLRoot As Long
    pszDisplayName As Long
    lpszTitle As Long
    ulFlags As Long
    lpfnCallback As Long
    lParam As Long
    iImage As Long
End Type
 
Const BIF_RETURNONLYFSDIRS = 1
Const MAX_PATH = 260
 
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
 
Private Sub GetFolder()
Dim iNullChrPos As Integer
Dim lpIDFolderList As Long
Dim strPath As String
Dim oBrowseInfo As BrowseInfo
 
    With oBrowseInfo
        .hWndOwner = Me.hWnd
        .lpszTitle = lstrcat("C:\", "")
        .ulFlags = BIF_RETURNONLYFSDIRS
    End With
 
    lpIDFolderList = SHBrowseForFolder(oBrowseInfo)
    If lpIDFolderList Then
        strPath = String$(MAX_PATH, 0)
        SHGetPathFromIDList lpIDFolderList, strPath
        CoTaskMemFree lpIDFolderList
        iNullChrPos = InStr(strPath, vbNullChar)
        If iNullChrPos Then
            strPath = Left$(strPath, iNullChrPos - 1)
        End If
    End If
 
    Me!Textbox1 = strPath
End Sub

Bonne journée

Argy

[HiT]

ok je rentre ce code...
ensuite j affecte à un bouton le code suivant???

Me.rep=getfolder ()??? si rep est mon controle....?
je fais comment?

[HiT]

dsl pour ma derniere intervention bete lol... j ai capté merci
ensuite a tu une sol pour la deuxieme partie du probleme...
je souhaiterais parcourir les fichiers de ce repertoire et y effectuer un traitement.... (traitement identique pour chaque fichier)
comment puis je faire pour parcourir les fichiers??? ce sont des fichiers texte. et en fait je souhaite juste les lire... et recuperer une donnée voila.

[BlakSun]

Bonjour,

Si lorsque tu parle de parcourire tes fichiers texte tu entends les ouvrires pour en lire le contenue l'instruction open est peut etre ce que tu cherches.
Avec l'instruction get tu peux normalement récupérer des données d'un fichier ouvert via open.
Malheureusement je ne pourrais pas t'aider plus n'ayant jamais utiliser ces fonctions.

bonne chance
@+
BkS.

[argyronet]

RE,

Eh bien c'est une autre API qu'il faut utiliser: GetOpenFileName ...
Elle se basera sur le dossier sélectionné dans le TextBox.

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
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Type OPENFILENAME
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type
Private Sub OpenDirectory()
    Dim OFName As OPENFILENAME
    OFName.lStructSize = Len(OFName)
    OFName.hwndOwner = Me.hWnd
    OFName.hInstance = App.hInstance
    OFName.lpstrFilter = "Fichiers texte (*.txt)" + Chr$(0) + "*.txt" + Chr$(0) + "Tous fichiers(*.*)" + Chr$(0) + "*.*" + Chr$(0)
    OFName.lpstrFile = Space$(254)
    OFName.nMaxFile = 255
    OFName.lpstrFileTitle = Space$(254)
    OFName.nMaxFileTitle = 255
    OFName.lpstrInitialDir = Me!TxtFolder
    OFName.lpstrTitle = "Parcourir le dossier"
    OFName.flags = 0
 
    If GetOpenFileName(OFName) Then
        MsgBox "Vous avez sélectionné " + Trim$(OFName.lpstrFile), 64
    Else
        MsgBox "Vous avez annulé, dommage...", 48
    End If
End Sub

A+

Argy

[HiT]

open pour ouvrir le fichier va tres bien... le pb ne concerne pas les traitement sur les fichiers... je vous donne un exemple...
imaginons un repertoire monrep avec des fichiers fic1, fic2, fic3....

je voudrais un algo du genre


tant que non fin de "monrep"
faire opération sur fichier
fichier suivant
fin tant que

et donc ca feré une boucle sur tous les fichiers....

[shwin]

tu veux un code qui fait la recherche dans un dossier et sous-dossier ?

cela va te permettre de manipuler les fichier tant que tu le veux.

[argyronet]

Re,

Ce qui se conçoit bien s'ennonce clairement !!!
Si vous ne dites pas tout, je ne peux pas le deviner...

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
Sub OuvrirTousLesFichiers() 
Dim NombreDeFichiers%, NomFichier$, Repertoire$
Repertoire = Me!TextFolder  & "\"
NomFichier = Dir(Repertoire, vbNormal) 
Do While NomFichier <> "" 
    If NomFichier <> "." And NomFichier <> ".." Then 
      If (GetAttr(Repertoire & NomFichier) And vbNormal) = vbNormal Then 
        'C'est un exemple d'ouverture 
        Call ProcédureOuvertureFichier
      NombreDeFichiers =NombreDeFichiers +1
      End If 
    End If 
NomFichier = Dir() 
Loop 
MsgBox "il y a eu " & NombreDeFichiers & " fichier(s) ouvert(s) et traité(s)..." 
End Sub 
 
Sub ProcédureOuvertureFichier(ByVal NomDuFichier As String, ByVal Dossier As String) 
Shell Application.hWndAccessApp, "open", NomDuFichier, vbNullString, Dossier, SW_SHOWNORMAL 
End Sub

Avec un truc comme ça ou approchant, ça devrait aller...
Veillez toutefois aux extensions désirées et tout le toutim dans la boucle.

Argy

[HiT]

merci
j ai collé ce code.
je recupere la directory du repertoire dans me.rep...
ensuite je fais un bouton pour executer le parcours du repertoire...

Code :

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

1
2
3
Private Sub Command3_Click()
OuvrirTousLesFichiers()
End Sub

mais y a erreur
comment il s utilise?

[HiT]

ca y est ca marche.. mais pb, il realise le traitement unikement sur le premier fichier, il passe pas au suivant.

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
 
Sub OuvrirTousLesFichiers()
Dim NombreDeFichiers%, NomFichier$, Repertoire$
Repertoire = Me!rep & "\"
NomFichier = Dir(Repertoire, vbNormal)
Do While NomFichier <> ""
    If NomFichier <> "." And NomFichier <> ".." Then
          Call formatage(NomFichier)
      End If
 
    Loop
End Sub

[HiT]

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
Sub OuvrirTousLesFichiers()
Dim NombreDeFichiers%, NomFichier$, Repertoire$
Repertoire = Me!rep & "\"
NomFichier = Dir(Repertoire, vbNormal)
Do While NomFichier <> ""
    If NomFichier <> "." And NomFichier <> ".." Then
      If (GetAttr(Repertoire & NomFichier) And vbNormal) = vbNormal Then
 
        Call formatage(NomFichier)
      NombreDeFichiers = NombreDeFichiers + 1
      End If
    End If
NomFichier = Dir()
Loop
 
End Sub

et la ca ne marche carremet plus, il me dit qu il ne trouve pas le fichchier....
:'(

[HiT]

ensuite dans la fonction formatage, il ne trouve pas le fichier car dans la fonction formatage, j ai placé une textbox dir(fi) et il renvoie rien.... donc c'est qu en ouvrant un fichier, il ne renvoie pas un nom de fichier total avec sa directory...mais juste le nom...

[HiT]

j ai resolu ca.. mais je n arrive tjr pa a passer au traitement du second fichier... :'(

[HiT]

en fait il me faudrait une instruction qui me permette de passer au fichier suivant.

[argyronet]

Re,

La boucle [Do While NomFichier <> "" ] fait cela...
Essayez la dans un module seul en passsant un chemin connu dans la variable Repertoire et en mode DEBUG (F8)...

En revanche, il faut passer le chemin complet dans l'appel :

Code :

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

Call formatage(NomFichier)

Ce que vous avez omis de faire...

A+
Argy

[shwin]

Salut hit, voici ma méthode de recherche de fichier

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
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
105
106
107
108
109
110
111
112
113
 
Option Compare Database
Option Explicit
 
Public AnnulerRech As Boolean
 
'----------------------------------------
'------Déclarations propres aux API------
'----------------------------------------
'---Les constantes---
Public Const MAX_PATH = 260
Public Const INVALID_HANDLE_VALUE = -1
Public Const FILE_ATTRIBUTE_READONLY = &H1
Public Const FILE_ATTRIBUTE_HIDDEN = &H2
Public Const FILE_ATTRIBUTE_SYSTEM = &H4
Public Const FILE_ATTRIBUTE_DIRECTORY = &H10
Public Const FILE_ATTRIBUTE_ARCHIVE = &H20
Public Const FILE_ATTRIBUTE_NORMAL = &H80
Public Const FILE_ATTRIBUTE_TEMPORARY = &H100
Public Const FILE_ATTRIBUTE_COMPRESSED = &H800
 
'---Les API---
Public Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" _
         (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" _
         (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
 
'---Les types---
Public Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type
 
Public Type WIN32_FIND_DATA
    dwFileAttributes As Long
    ftCreationTime As FILETIME
    ftLastAccessTime As FILETIME
    ftLastWriteTime As FILETIME
    nFileSizeHigh As Long
    nFileSizeLow As Long
    dwReserved0 As Long
    dwReserved1 As Long
    cFileName As String * MAX_PATH
    cAlternate As String * 14
End Type
 
'----------------------------------------------
'------Déclarations propres à la fonction------
'----------------------------------------------
Public Type ListeFichier
    Fichiers() As WIN32_FIND_DATA
    Chemin() As String * MAX_PATH
    Nombre As Long
End Type
 
'--------------------------------------------------------
'---La fonction Rechercher : ---
'--- Cette fonction recherche tous les fichiers dans ---
'--- le répertoire spécifié et ses sous-repertoires ---
'--- Elle retourne le nombre d'occurences trouvées ---
'--------------------------------------------------------
Public Function Rechercher(Chemin As String, FichierR As String, _
        ResultatRecherche As ListeFichier) As Long
'---Déclaration des variables---
Dim lpFindFileData As WIN32_FIND_DATA
Dim hFindFile As Long
Dim lgRep As Long
Dim CheminRep As String
'---Recherche tous les fichiers demandés dans le répertoire Chemin---
hFindFile = FindFirstFile(Chemin & FichierR, lpFindFileData)
If hFindFile <> INVALID_HANDLE_VALUE Then
    Do
        ' Mémorise
        ResultatRecherche.Nombre = ResultatRecherche.Nombre + 1
        ReDim Preserve ResultatRecherche.Chemin(1 To ResultatRecherche.Nombre)
        ReDim Preserve ResultatRecherche.Fichiers(1 To ResultatRecherche.Nombre)
        ResultatRecherche.Chemin(ResultatRecherche.Nombre) = Chemin
        ResultatRecherche.Fichiers(ResultatRecherche.Nombre) = lpFindFileData
        ' Initialise lpFindFileData (Variable texte uniquement)
        lpFindFileData.cAlternate = String$(14, 0)
        lpFindFileData.cFileName = String$(MAX_PATH, 0)
        DoEvents
    Loop Until FindNextFile(hFindFile, lpFindFileData) = 0 Or AnnulerRech = True
End If
FindClose hFindFile
'---Recherche dans les sous-répertoires---
hFindFile = FindFirstFile(Chemin & "*.*", lpFindFileData)
If (hFindFile <> INVALID_HANDLE_VALUE) Then
    Do
        ' Si c'est un répertoire on continu la recherche
        If (lpFindFileData.dwFileAttributes And _
            FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY Then
            ' Extraction du nom du répertoire
            CheminRep = Mid$(lpFindFileData.cFileName, 1, _
                        InStr(1, lpFindFileData.cFileName, Chr$(0)) - 1)
            ' Attention dans les sous-répertoire aux
            ' répertoires . et .. (Retour répertoire parent)
            If (CheminRep <> ".") And (CheminRep <> "..") Then
                CheminRep = Chemin & CheminRep & "\"
 
                SysCmd acSysCmdSetStatus, "Dossier: " & CheminRep
                Rechercher = Rechercher(CheminRep, FichierR, ResultatRecherche)
            End If
        End If
        DoEvents
    Loop Until FindNextFile(hFindFile, lpFindFileData) = 0 Or AnnulerRech = True
End If
FindClose hFindFile
SysCmd acSysCmdClearStatus
'---Retourne le nombre d'occurrences trouvées---
Rechercher = ResultatRecherche.Nombre
End Function

je l'appel comme ceci

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
 
Private Sub BtnLancerRech_Click()
 
 
If ((Not IsNull(edtPath.Value)) And (edtPath.Value <> "")) Then
    btnFocus.SetFocus
    BtnRech.Visible = False
    BtnLancerRech.Visible = False
    BtnAnnulerRech.Visible = True
 
    Dim ResultatRecherche As ListeFichier
    Dim NombreOccurence As Long
    Dim i As Integer
    Dim r As Variant
 
    '---Recherche de tous les fichiers
    lstPath.RowSource = "Résultat de la recherche;"
    AnnulerRech = False 'variable public pour annuler la recherche (true = annuler)
    SysCmd acSysCmdSetStatus, " "
    Select Case MainOptionBD.Value
        Case 1: NombreOccurence = Rechercher(edtPath.Value, BDGift, ResultatRecherche)
        Case 2: NombreOccurence = Rechercher(edtPath.Value, BDCorporatif, ResultatRecherche)
        Case 3: NombreOccurence = Rechercher(edtPath.Value, BDDeveloppement, ResultatRecherche)
        Case 4: NombreOccurence = Rechercher(edtPath.Value, BDCorporatif_Developement, ResultatRecherche)
        Case 5: NombreOccurence = Rechercher(edtPath.Value, BDGOD, ResultatRecherche)
    End Select
    ' Toutes les informations de la recherche sont dans la variables ResultatRecherche
    For i = 1 To NombreOccurence
        lstPath.RowSource = lstPath.RowSource & Trim$(ResultatRecherche.Chemin(i)) & Trim$(ResultatRecherche.Fichiers(i).cFileName)
        lstPath.RowSource = lstPath.RowSource & ";"
    Next
    BtnRech.Visible = True
    BtnLancerRech.Visible = True
    BtnAnnulerRech.Visible = False
    Else: MsgBox "Veuillez sélectionner un chemin pour la recherche.", vbInformation, "Information"
End If
End Sub

à toi de maintenant la modifier pour quelle convienne à TES besoins

shwin

[HiT]

merci swhimm mais il ne connait pas tes private ke tu definis...

Code :

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

1
2
3
4
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long

[HiT]

et si je le met dans un module ca amrche pas

[HiT]

argyronet, je passe le nom complet donc cela m effectue le bon traitement mais ensuite, cela ne passe pas au fichier suivant...
avec un for each et un next ca pourrait marcher... mais kan je declare un filesystemobject il refuse :'(