Lister des fichiers
Résolu
mirmoleboss
Messages postés
303
Date d'inscription
mercredi 11 octobre 2006
Statut
Membre
Dernière intervention
29 juillet 2011
-
11 mai 2007 à 21:58
Sebdr - 29 mai 2007 à 20:03
Sebdr - 29 mai 2007 à 20:03
44 réponses
jmfmarques
Messages postés
7666
Date d'inscription
samedi 5 novembre 2005
Statut
Membre
Dernière intervention
22 août 2014
27
12 mai 2007 à 19:47
12 mai 2007 à 19:47
Bon...
Si vous n'y parvenez pas, je reviens dans deux heures (après diner) avec le char d'assaut (fonctions de l'Api de Windows), donc... et ce sera résolu, ma foi !
Si vous n'y parvenez pas, je reviens dans deux heures (après diner) avec le char d'assaut (fonctions de l'Api de Windows), donc... et ce sera résolu, ma foi !
mirmoleboss
Messages postés
303
Date d'inscription
mercredi 11 octobre 2006
Statut
Membre
Dernière intervention
29 juillet 2011
12 mai 2007 à 19:58
12 mai 2007 à 19:58
bah je tattends mon cher
mortalino
Messages postés
6786
Date d'inscription
vendredi 16 décembre 2005
Statut
Membre
Dernière intervention
21 décembre 2011
18
12 mai 2007 à 21:46
12 mai 2007 à 21:46
Bon j'ai regardé, aucun équivalent en 2007 de FileSearch (alors que 2003, oui)
Regression de VBA ?
Attends de voir la soluce de Jacques (après son Pastis )
@++
<hr size="2" width="100%" />
--Mortalino--
Le mystérieux chevalier, ~Provençal, le Gaulois~
Regression de VBA ?
Attends de voir la soluce de Jacques (après son Pastis )
@++
<hr size="2" width="100%" />
--Mortalino--
Le mystérieux chevalier, ~Provençal, le Gaulois~
mirmoleboss
Messages postés
303
Date d'inscription
mercredi 11 octobre 2006
Statut
Membre
Dernière intervention
29 juillet 2011
12 mai 2007 à 21:53
12 mai 2007 à 21:53
ok moi aussi
car il en met du temps lol
on lattends avec impatience
mais jepense que ca a changer de nom
car il en met du temps lol
on lattends avec impatience
mais jepense que ca a changer de nom
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
jmfmarques
Messages postés
7666
Date d'inscription
samedi 5 novembre 2005
Statut
Membre
Dernière intervention
22 août 2014
27
12 mai 2007 à 22:28
12 mai 2007 à 22:28
Bon ...
Le vin était bon à table ...
J'ai donc fait ceci, à la méthode "grosse artillerie"
Réclame un bouton de commande Commande1 et un listbox List1
Je laisse le soin à mortalino de modifier pour écxrire dans les cellules plut^pt que dans la Listbox
Const MAX_PATH = 260
Const MAXDWORD = &HFFFF
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Type FILETIME
DateInfX As Long
DateSupX As Long
End Type
Private Type WIN32_FIND_DATA
AttributsX As Long
CreationTimeX As FILETIME
LastAccessTimeX As FILETIME
LastWriteTimeX As FILETIME
TailleSupX As Long
TailleInfX As Long
Reserve0X As Long
Reserve1X As Long
nomficX As String * MAX_PATH '
AlterneX As String * 14
End Type
Private Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAborted As Boolean
hNameMaps As Long
sProgress As String
End Type
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
Private Declare Function SetFileAttributes Lib "kernel32" Alias "SetFileAttributesA" (ByVal lpFileName As String, ByVal dwFileAttributes As Long) As Long
Const REPATTR = &H10
Const ARCHIVEATTR = &H20
Const CACHEATTR = &H2
Const NORMALATTR = &H80
Const READONLYATTR = &H1
Const SYSTEMATTR = &H4
Const TEMPATTR = &H100
Private Sub listonsdonc_Click()
derep$ = "d:\monoutil" ' ici ton répertoire
filtre$ = ".avi" 'ici ton filtre
allonsy derep$, derep$, filtre$
DoEvents
End Sub
Public Function allonsy(chemin As String, chemin0 As String, filtre As String)
Dim SHFileOp As SHFILEOPSTRUCT
Dim NomFic As String, nomrep As String, repnoms() As String, nbrep As Integer
Dim I As Integer, cherchechemin As Long, combtrouv As Integer
Dim WFD As WIN32_FIND_DATA
If Right(chemin, 1) <> "" Then chemin = chemin & ""
If Right(chemin0, 1) <> "" Then chemin0 = chemin0 & "" nbrep 0: combtrouv True
ReDim repnoms(nbrep)
cherchechemin = FindFirstFile(chemin & "*", WFD)
If cherchechemin <> -1 Then
Do While combtrouv
nomrep = WFD.nomficX
If (InStr(nomrep, Chr(0)) > 0) Then nomrep = Left(nomrep, InStr(nomrep, Chr(0)) - 1)
If (nomrep <> ".") And (nomrep <> "..") Then
If GetFileAttributes(chemin & nomrep) And REPATTR Then repnoms(nbrep) nomrep: nbrep nbrep + 1
ReDim Preserve repnoms(nbrep)
End If
End If
combtrouv = FindNextFile(cherchechemin, WFD)
Loop
combtrouv = FindClose(cherchechemin)
End If
cherchechemin = FindFirstFile(chemin & "*", WFD)
combtrouv = True
If cherchechemin <> -1 Then
While combtrouv
NomFic = WFD.nomficX
If (InStr(NomFic, Chr(0)) > 0) Then NomFic = Left(NomFic, InStr(NomFic, Chr(0)) - 1)
If (NomFic <> ".") And (NomFic <> "..") Then
allonsy = allonsy + (WFD.TailleSupX * MAXDWORD) + WFD.TailleInfX
On Error Resume Next
If chemin <> "" Then
ssplit = InStr(chemin & NomFic, chemin0)
tou = Mid(chemin & NomFic, ssplit + Len(chemin0) - 1)
If GetFileAttributes(chemin & NomFic) And REPATTR Then 's'il s'agit d'un répertoire
On Error Resume Next
toto = &H0
If GetFileAttributes(chemin & NomFic) And CACHEATTR Then toto = toto Or CACHEATTR
If GetFileAttributes(chemin & NomFic) And READONLYATTR Then toto = toto Or READONLYATTR
If GetFileAttributes(chemin & NomFic) And SYSTEMATTR Then toto = toto Or SYSTEMATTR
If GetFileAttributes(chemin & NomFic) And ARCHIVEATTR Then toto = toto Or ARCHIVEATTR
SetFileAttributes torep & tou, toto
Err.Clear
Else
myattr = GetAttr(chemin & NomFic)
If Right(chemin & NomFic, Len(filtre)) = filtre Then
List1.AddItem chemin & NomFic ' c'est ici, Mortalino que tu dois faire intrervenir les cellules de VBA
List1.Refresh ' et la aussi, bien sur
End If
End If
End If
Err.Clear
End If
combtrouv = FindNextFile(cherchechemin, WFD)
Wend
combtrouv = FindClose(cherchechemin)
End If
If nbrep > 0 Then
For I = 0 To nbrep - 1
allonsy = allonsy & allonsy(chemin & repnoms(I) & "", chemin0, filtre)
Next I
End If
End Function
Désolé de déballer toute cette artillerie (je vaus m'attacher( cette semaine à faire la même chose mais sans API)....
Sésolé également d'être si lourd, mais le vin me joue des tours, apparemment... et les yeux papillotent un peu...
Mais tout marche bien (testé).
.
Le vin était bon à table ...
J'ai donc fait ceci, à la méthode "grosse artillerie"
Réclame un bouton de commande Commande1 et un listbox List1
Je laisse le soin à mortalino de modifier pour écxrire dans les cellules plut^pt que dans la Listbox
Const MAX_PATH = 260
Const MAXDWORD = &HFFFF
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Type FILETIME
DateInfX As Long
DateSupX As Long
End Type
Private Type WIN32_FIND_DATA
AttributsX As Long
CreationTimeX As FILETIME
LastAccessTimeX As FILETIME
LastWriteTimeX As FILETIME
TailleSupX As Long
TailleInfX As Long
Reserve0X As Long
Reserve1X As Long
nomficX As String * MAX_PATH '
AlterneX As String * 14
End Type
Private Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAborted As Boolean
hNameMaps As Long
sProgress As String
End Type
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
Private Declare Function SetFileAttributes Lib "kernel32" Alias "SetFileAttributesA" (ByVal lpFileName As String, ByVal dwFileAttributes As Long) As Long
Const REPATTR = &H10
Const ARCHIVEATTR = &H20
Const CACHEATTR = &H2
Const NORMALATTR = &H80
Const READONLYATTR = &H1
Const SYSTEMATTR = &H4
Const TEMPATTR = &H100
Private Sub listonsdonc_Click()
derep$ = "d:\monoutil" ' ici ton répertoire
filtre$ = ".avi" 'ici ton filtre
allonsy derep$, derep$, filtre$
DoEvents
End Sub
Public Function allonsy(chemin As String, chemin0 As String, filtre As String)
Dim SHFileOp As SHFILEOPSTRUCT
Dim NomFic As String, nomrep As String, repnoms() As String, nbrep As Integer
Dim I As Integer, cherchechemin As Long, combtrouv As Integer
Dim WFD As WIN32_FIND_DATA
If Right(chemin, 1) <> "" Then chemin = chemin & ""
If Right(chemin0, 1) <> "" Then chemin0 = chemin0 & "" nbrep 0: combtrouv True
ReDim repnoms(nbrep)
cherchechemin = FindFirstFile(chemin & "*", WFD)
If cherchechemin <> -1 Then
Do While combtrouv
nomrep = WFD.nomficX
If (InStr(nomrep, Chr(0)) > 0) Then nomrep = Left(nomrep, InStr(nomrep, Chr(0)) - 1)
If (nomrep <> ".") And (nomrep <> "..") Then
If GetFileAttributes(chemin & nomrep) And REPATTR Then repnoms(nbrep) nomrep: nbrep nbrep + 1
ReDim Preserve repnoms(nbrep)
End If
End If
combtrouv = FindNextFile(cherchechemin, WFD)
Loop
combtrouv = FindClose(cherchechemin)
End If
cherchechemin = FindFirstFile(chemin & "*", WFD)
combtrouv = True
If cherchechemin <> -1 Then
While combtrouv
NomFic = WFD.nomficX
If (InStr(NomFic, Chr(0)) > 0) Then NomFic = Left(NomFic, InStr(NomFic, Chr(0)) - 1)
If (NomFic <> ".") And (NomFic <> "..") Then
allonsy = allonsy + (WFD.TailleSupX * MAXDWORD) + WFD.TailleInfX
On Error Resume Next
If chemin <> "" Then
ssplit = InStr(chemin & NomFic, chemin0)
tou = Mid(chemin & NomFic, ssplit + Len(chemin0) - 1)
If GetFileAttributes(chemin & NomFic) And REPATTR Then 's'il s'agit d'un répertoire
On Error Resume Next
toto = &H0
If GetFileAttributes(chemin & NomFic) And CACHEATTR Then toto = toto Or CACHEATTR
If GetFileAttributes(chemin & NomFic) And READONLYATTR Then toto = toto Or READONLYATTR
If GetFileAttributes(chemin & NomFic) And SYSTEMATTR Then toto = toto Or SYSTEMATTR
If GetFileAttributes(chemin & NomFic) And ARCHIVEATTR Then toto = toto Or ARCHIVEATTR
SetFileAttributes torep & tou, toto
Err.Clear
Else
myattr = GetAttr(chemin & NomFic)
If Right(chemin & NomFic, Len(filtre)) = filtre Then
List1.AddItem chemin & NomFic ' c'est ici, Mortalino que tu dois faire intrervenir les cellules de VBA
List1.Refresh ' et la aussi, bien sur
End If
End If
End If
Err.Clear
End If
combtrouv = FindNextFile(cherchechemin, WFD)
Wend
combtrouv = FindClose(cherchechemin)
End If
If nbrep > 0 Then
For I = 0 To nbrep - 1
allonsy = allonsy & allonsy(chemin & repnoms(I) & "", chemin0, filtre)
Next I
End If
End Function
Désolé de déballer toute cette artillerie (je vaus m'attacher( cette semaine à faire la même chose mais sans API)....
Sésolé également d'être si lourd, mais le vin me joue des tours, apparemment... et les yeux papillotent un peu...
Mais tout marche bien (testé).
.
jmfmarques
Messages postés
7666
Date d'inscription
samedi 5 novembre 2005
Statut
Membre
Dernière intervention
22 août 2014
27
13 mai 2007 à 07:14
13 mai 2007 à 07:14
Bonjour MPI,
Oui ! Mets celà sur Codyx (tant VBA que VB), en envoyant sans une listbox pour VB et dans des cellules pour VBA, si tu veux.
Celà me parait utile.
Bon dimanche
Oui ! Mets celà sur Codyx (tant VBA que VB), en envoyant sans une listbox pour VB et dans des cellules pour VBA, si tu veux.
Celà me parait utile.
Bon dimanche
mirmoleboss
Messages postés
303
Date d'inscription
mercredi 11 octobre 2006
Statut
Membre
Dernière intervention
29 juillet 2011
13 mai 2007 à 09:14
13 mai 2007 à 09:14
merci mpi jai regarder ton code il fonctionne et je le trouve tres bien mais enfete il ne me donne pas entiere satisfaction car le resultat est donné sous cette forme
C:\Documents and Settings\Le Floch\Mes documents\torrent\Finit\Aquamarine.avi
comment faire pour lavoir
Aquamarine.avi
par contre [auteurdetail.aspx?ID=615490 jmfmarques] jai fait ta methode et nobtient aucun resultat faut que je regarde ca de plsu pres
merci à tous davance
C:\Documents and Settings\Le Floch\Mes documents\torrent\Finit\Aquamarine.avi
comment faire pour lavoir
Aquamarine.avi
par contre [auteurdetail.aspx?ID=615490 jmfmarques] jai fait ta methode et nobtient aucun resultat faut que je regarde ca de plsu pres
merci à tous davance
jmfmarques
Messages postés
7666
Date d'inscription
samedi 5 novembre 2005
Statut
Membre
Dernière intervention
22 août 2014
27
13 mai 2007 à 09:23
13 mai 2007 à 09:23
Bonjour,
Avec ma méthode, tu ne verras de résultat que si tu modifies (affichage dans tes cellules comme te l'as montré Mortalino et non dans la Listbox... là où j'ai écrit en rouge gras ...)
Pour ce qui est de ce que tu veux afficher (le fichier sans le chemin), tu fais fort, là ...
Il te suffit de modifier (dans le code de MPI) :
ActiveSheet.Range("A" & Ligne) = Chemin & Fichier
par :
ActiveSheet.Range("A" & Ligne) = Fichier
pareil dans mon code :
modifier :
List1.AddItem chemin & NomFic
par
List1.AddItem NomFic
C'est évident !!!!
Avec ma méthode, tu ne verras de résultat que si tu modifies (affichage dans tes cellules comme te l'as montré Mortalino et non dans la Listbox... là où j'ai écrit en rouge gras ...)
Pour ce qui est de ce que tu veux afficher (le fichier sans le chemin), tu fais fort, là ...
Il te suffit de modifier (dans le code de MPI) :
ActiveSheet.Range("A" & Ligne) = Chemin & Fichier
par :
ActiveSheet.Range("A" & Ligne) = Fichier
pareil dans mon code :
modifier :
List1.AddItem chemin & NomFic
par
List1.AddItem NomFic
C'est évident !!!!
mirmoleboss
Messages postés
303
Date d'inscription
mercredi 11 octobre 2006
Statut
Membre
Dernière intervention
29 juillet 2011
13 mai 2007 à 09:25
13 mai 2007 à 09:25
ah et puis une petite chose en plus
est ce possible que lutilisateur puissse changer le dossier de recherche sans passer par le code de programmation
Genre sous il ya un bouton parcourir et il selectionne le dossier a analyser sois il rentre dans une textebox le chemin directement
merci encore
est ce possible que lutilisateur puissse changer le dossier de recherche sans passer par le code de programmation
Genre sous il ya un bouton parcourir et il selectionne le dossier a analyser sois il rentre dans une textebox le chemin directement
merci encore
mirmoleboss
Messages postés
303
Date d'inscription
mercredi 11 octobre 2006
Statut
Membre
Dernière intervention
29 juillet 2011
13 mai 2007 à 09:30
13 mai 2007 à 09:30
(javais pas vu ta reponse merci)
tellement evident que javais pas vu lol
desolé
tellement evident que javais pas vu lol
desolé
mortalino
Messages postés
6786
Date d'inscription
vendredi 16 décembre 2005
Statut
Membre
Dernière intervention
21 décembre 2011
18
13 mai 2007 à 10:31
13 mai 2007 à 10:31
Voici un code smple pour le choix du dossier (attention tout de même, aucune gestion d'erreur), testé sous 2007 :
Sub test()
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
With fd
.InitialFileName = "C:"
.Show
MsgBox .SelectedItems(1)
End With
End Sub
~
<small>[code.aspx?ID=39466 Mortalino] ~
Colorisation automatique</small>
@++
<hr size="2" width="100%" />
--Mortalino--
Le mystérieux chevalier, ~Provençal, le Gaulois~
Sub test()
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
With fd
.InitialFileName = "C:"
.Show
MsgBox .SelectedItems(1)
End With
End Sub
~
<small>[code.aspx?ID=39466 Mortalino] ~
Colorisation automatique</small>
@++
<hr size="2" width="100%" />
--Mortalino--
Le mystérieux chevalier, ~Provençal, le Gaulois~
mirmoleboss
Messages postés
303
Date d'inscription
mercredi 11 octobre 2006
Statut
Membre
Dernière intervention
29 juillet 2011
13 mai 2007 à 17:36
13 mai 2007 à 17:36
merci bah enfete apres comment je fais pour dire .selectitems(1) est egal a chemininitial
et une fosi ca fais dans le code de base je met ca?
'Déterminer le chemin de base
Chemin = chemininitial ?????
merci davance
et une fosi ca fais dans le code de base je met ca?
'Déterminer le chemin de base
Chemin = chemininitial ?????
merci davance
mirmoleboss
Messages postés
303
Date d'inscription
mercredi 11 octobre 2006
Statut
Membre
Dernière intervention
29 juillet 2011
14 mai 2007 à 09:22
14 mai 2007 à 09:22
merci,cette reponse est tres bien aussi mais ocmment faire pour selectionnez le dossier directement sans passer par le code de programation
merci
merci
jrivet
Messages postés
7392
Date d'inscription
mercredi 23 avril 2003
Statut
Membre
Dernière intervention
6 avril 2012
60
14 mai 2007 à 09:27
14 mai 2007 à 09:27
mirmoleboss
Messages postés
303
Date d'inscription
mercredi 11 octobre 2006
Statut
Membre
Dernière intervention
29 juillet 2011
14 mai 2007 à 18:31
14 mai 2007 à 18:31
merci
mais voila a quoi jai le droit
Public Function BrosweForFolder(NameForm As Form, Title As String) As String
avec lerreur type defini par lutilisateur non definit
je pense que jai pas bien place le code
merci
mais voila a quoi jai le droit
Public Function BrosweForFolder(NameForm As Form, Title As String) As String
avec lerreur type defini par lutilisateur non definit
je pense que jai pas bien place le code
merci
mortalino
Messages postés
6786
Date d'inscription
vendredi 16 décembre 2005
Statut
Membre
Dernière intervention
21 décembre 2011
18
14 mai 2007 à 18:38
14 mai 2007 à 18:38
Nop, c'est un odule pour VB6, voici la correction :
Option Explicit
Private Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Private Const BIF_RETURNONLYFSDIRS = &H1
Private Const BIF_DONTGOBELOWDOMAIN = &H2
Private Const BIF_STATUSTEXT = &H4
Private Const BIF_RETURNFSANCESTORS = &H8
Private Const BIF_BROWSEFORCOMPUTER = &H1000
Private Const BIF_BROWSEFORPRINTER = &H2000
Private Const MAX_PATH = 260
Private Declare Function SHGetPathFromIDList Lib "shell32" _
Alias "SHGetPathFromIDListA" _
(ByVal pidl As Long, _
ByVal pszPath As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32" _
Alias "SHBrowseForFolderA" _
(lpBrowseInfo As BROWSEINFO) As Long
Private Declare Sub CoTaskMemFree Lib "ole32" _
(ByVal pv As Long)
' J'ai spprimé le param Form
Public Function BrosweForFolder(Title As
String) As
String
Dim bi As BROWSEINFO
Dim pidl As Long
Dim path As String
Dim pos As Integer
' et je récupere le handle de Excel (au lieu de Form)
bi.hOwner = Application.Hwnd
bi.pidlRoot = 0&
bi.lpszTitle = Title
bi.ulFlags = BIF_RETURNONLYFSDIRS
pidl = SHBrowseForFolder(bi)
path = Space$(MAX_PATH)
If SHGetPathFromIDList(ByVal pidl, ByVal path) Then
pos = InStr(path, Chr$(0))
path = Left(path, pos - 1)
If Right(path, 1) = "" Then
BrosweForFolder = Left(path, pos - 1)
Else
BrosweForFolder = Left(path, pos - 1) & ""
End If
End If
Call CoTaskMemFree(pidl)
End Function
~
<small>[code.aspx?ID=39466 Mortalino] ~
Colorisation automatique</small>
@++
<hr size="2" width="100%" />
--Mortalino--
Le mystérieux chevalier, ~Provençal, le Gaulois~
Option Explicit
Private Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Private Const BIF_RETURNONLYFSDIRS = &H1
Private Const BIF_DONTGOBELOWDOMAIN = &H2
Private Const BIF_STATUSTEXT = &H4
Private Const BIF_RETURNFSANCESTORS = &H8
Private Const BIF_BROWSEFORCOMPUTER = &H1000
Private Const BIF_BROWSEFORPRINTER = &H2000
Private Const MAX_PATH = 260
Private Declare Function SHGetPathFromIDList Lib "shell32" _
Alias "SHGetPathFromIDListA" _
(ByVal pidl As Long, _
ByVal pszPath As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32" _
Alias "SHBrowseForFolderA" _
(lpBrowseInfo As BROWSEINFO) As Long
Private Declare Sub CoTaskMemFree Lib "ole32" _
(ByVal pv As Long)
' J'ai spprimé le param Form
Public Function BrosweForFolder(Title As
String) As
String
Dim bi As BROWSEINFO
Dim pidl As Long
Dim path As String
Dim pos As Integer
' et je récupere le handle de Excel (au lieu de Form)
bi.hOwner = Application.Hwnd
bi.pidlRoot = 0&
bi.lpszTitle = Title
bi.ulFlags = BIF_RETURNONLYFSDIRS
pidl = SHBrowseForFolder(bi)
path = Space$(MAX_PATH)
If SHGetPathFromIDList(ByVal pidl, ByVal path) Then
pos = InStr(path, Chr$(0))
path = Left(path, pos - 1)
If Right(path, 1) = "" Then
BrosweForFolder = Left(path, pos - 1)
Else
BrosweForFolder = Left(path, pos - 1) & ""
End If
End If
Call CoTaskMemFree(pidl)
End Function
~
<small>[code.aspx?ID=39466 Mortalino] ~
Colorisation automatique</small>
@++
<hr size="2" width="100%" />
--Mortalino--
Le mystérieux chevalier, ~Provençal, le Gaulois~
mirmoleboss
Messages postés
303
Date d'inscription
mercredi 11 octobre 2006
Statut
Membre
Dernière intervention
29 juillet 2011
14 mai 2007 à 18:44
14 mai 2007 à 18:44
ok merci mais maitenant jai un type dargument byfer incompatible
desole de vous embeter avec ca
Private Sub CommandButton1_Click()
Dim stra As String
stra = BrosweForFolder(frmMain, "Select Source Folder")
If stra <> "" Then
Call ListerAVI(New FileSystemObject, ActiveSheet, 1, "C:\Julien")
End If
End Sub
Sub ListerAVI(FSO As FileSystemObject, WSheet As Worksheet, Ligne As Long, Rep As String)
'répertoire dans lequel on recherche
'actuellement
Dim Fol As Folder
'Sous répertoires dans lequel on recherche
'actuellement
Dim SubFol As Folder
'Fichiers du rep
Dim Fil As File
Set Fol = FSO.GetFolder(Rep)
'pour chaque fichier du répertoire
For Each Fil In Fol.Files
'on regarde l'extension
If UCase(FSO.GetExtensionName(Fil.path & Fil.Name)) = "AVI" Then
WSheet.Range("A" & CStr(Ligne)) = Fil.Name 'juste le nom
'WSheet.Range("A" & CStr(Ligne)) = Fil.Path & Fil.Name 'Chemin + NOm
Ligne = Ligne + 1
End If
Next
'pour chaque repertoire on rapelle la meme procédure
For Each SubFol In Fol.SubFolders
Call ListerAVI(FSO, WSheet, Ligne, SubFol.path)
Next
'destruction des objets
Set Fol = Nothing
Set Fil = Nothing
Set SubFol = Nothing
End Sub
desole de vous embeter avec ca
Private Sub CommandButton1_Click()
Dim stra As String
stra = BrosweForFolder(frmMain, "Select Source Folder")
If stra <> "" Then
Call ListerAVI(New FileSystemObject, ActiveSheet, 1, "C:\Julien")
End If
End Sub
Sub ListerAVI(FSO As FileSystemObject, WSheet As Worksheet, Ligne As Long, Rep As String)
'répertoire dans lequel on recherche
'actuellement
Dim Fol As Folder
'Sous répertoires dans lequel on recherche
'actuellement
Dim SubFol As Folder
'Fichiers du rep
Dim Fil As File
Set Fol = FSO.GetFolder(Rep)
'pour chaque fichier du répertoire
For Each Fil In Fol.Files
'on regarde l'extension
If UCase(FSO.GetExtensionName(Fil.path & Fil.Name)) = "AVI" Then
WSheet.Range("A" & CStr(Ligne)) = Fil.Name 'juste le nom
'WSheet.Range("A" & CStr(Ligne)) = Fil.Path & Fil.Name 'Chemin + NOm
Ligne = Ligne + 1
End If
Next
'pour chaque repertoire on rapelle la meme procédure
For Each SubFol In Fol.SubFolders
Call ListerAVI(FSO, WSheet, Ligne, SubFol.path)
Next
'destruction des objets
Set Fol = Nothing
Set Fil = Nothing
Set SubFol = Nothing
End Sub
mortalino
Messages postés
6786
Date d'inscription
vendredi 16 décembre 2005
Statut
Membre
Dernière intervention
21 décembre 2011
18
14 mai 2007 à 18:46
14 mai 2007 à 18:46
Oui, vu que j'ai enlevé le param Form, il ne faut donc pas lui donner :
Private Sub CommandButton1_Click()
Dim stra As String
stra = BrosweForFolder(<strike> frmMain, </strike>"Select Source Folder")
If stra <> "" Then
....
@++
<hr size ="2" width="100%" />
--Mortalino--
Le mystérieux chevalier, ~Provençal, le Gaulois~
Private Sub CommandButton1_Click()
Dim stra As String
stra = BrosweForFolder(<strike> frmMain, </strike>"Select Source Folder")
If stra <> "" Then
....
@++
<hr size ="2" width="100%" />
--Mortalino--
Le mystérieux chevalier, ~Provençal, le Gaulois~
mirmoleboss
Messages postés
303
Date d'inscription
mercredi 11 octobre 2006
Statut
Membre
Dernière intervention
29 juillet 2011
14 mai 2007 à 19:06
14 mai 2007 à 19:06
enfin bon le pc rame et desfois il fait planter excel
mortalino
Messages postés
6786
Date d'inscription
vendredi 16 décembre 2005
Statut
Membre
Dernière intervention
21 décembre 2011
18
14 mai 2007 à 19:09
14 mai 2007 à 19:09
Peut-être normal, suivant la racine, ton PC listes tous les fichiers afin de procéder à es comparaisons.
Ajoute un DoEvents au début de la procédure mais tu ne peux que prendre ton mal en patience, et pour ce qui est du plantage d'Excel, il ne faut pas toucher Excel avant la fin de la recherche
@++
<hr size="2" width="100%" />
--Mortalino--
Le mystérieux chevalier, ~Provençal, le Gaulois~
Ajoute un DoEvents au début de la procédure mais tu ne peux que prendre ton mal en patience, et pour ce qui est du plantage d'Excel, il ne faut pas toucher Excel avant la fin de la recherche
@++
<hr size="2" width="100%" />
--Mortalino--
Le mystérieux chevalier, ~Provençal, le Gaulois~