on me donne ce fichier qui "devrait" lister les fichiers d'un répertoire
choisi;
le problème est le suivant:
Il liste bien une partie des fichiers XLS, XLSX et autres mais pas les
".PDF" ni ".JPG"
Je ne trouve pas mon erreur dans la ligne:
Trouvé = Not IsError(Application.Match(X, Array(".XLS", ".XLSM", ".XLSX",
".DOC", ".DOT", ".DOCX", "*.PDF", "*.JPG"), 0))
Quelqu'un sait me dire ce qui se passe ?
Question subsidiaire: je n'ai pas de réseau , mais la suite serait de
chercher les mêmes type de fichier en réseau, ce code est il suffisant ou
faut il autre chose ?
Merci
le code:
Option Explicit
Option Base 1
Sub ListeFichiers()
' lister les fichiers XL /Word/PDF/Jpg d'un répertoire au choix
'
Dim Racine
Dim Fs, Dossier, F, Ligne, Trouvé, X
Sheets("feuil1").Select
Range("A1").Value = "Nom de fichier-Lien"
Range("B1").Value = "Taille"
Range("C1").Value = "Création"
Range("D1").Value = "Modif"
Range("E1").Value = "Chemin"
Range("F1").Value = "Type"
Racine = CheminUser
Range("a2:F10000").ClearContents
Set Fs = CreateObject("Scripting.FileSystemObject")
Set Dossier = Fs.getfolder(Racine) 'DossierRacine
Ligne = 2
For Each F In Dossier.Files
X = UCase(Right(F.Name, 5)) ' ==> ".xlsm" ou ".PDF" etc etc....
Trouvé = Not IsError(Application.Match(X, Array(".XLS", ".XLSM",
".XLSX", ".DOC", ".DOT", ".DOCX", "*.PDF", "*.JPG"), 0))
If Not Trouvé Then
X = UCase(Right(F.Name, 4))
Trouvé = Not IsError(Application.Match(X, Array(".XLS", ".XLSM",
".XLSX", ".DOC", ".DOT", ".DOCX", "*.PDF", "*.JPG"), 0))
If Not Trouvé Then 'GoTo suivant
GoTo suivant
Else
GoTo ajout
End If
Else
GoTo ajout
End If
ajout:
Cells(Ligne, 1) = F.Name
Cells(Ligne, 1).Hyperlinks.Add Anchor:=Cells(Ligne, 1), Address:=Racine
& "\" & F.Name, TextToDisplay:=F.Name
Cells(Ligne, 2) = F.Size
Cells(Ligne, 3) = F.Datecreated
Cells(Ligne, 4) = F.DateLastModified
Cells(Ligne, 5) = Racine
Cells(Ligne, 6) = X
Ligne = Ligne + 1
suivant:
Next
End Sub
Function CheminUser() As String
Dim objShell As Object, objFolder As Object
Dim Chemin As String
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(0, "Sélectionnez dans
l'arborescence :", 513, 0)
If objFolder Is Nothing Then Exit Function
On Error Resume Next
Chemin = objFolder.Items.Item.Path ' & "\"
On Error GoTo 0
If Left(Chemin, 1) = ":" Then Chemin = ""
CheminUser = Chemin
End Function
---
L'absence de virus dans ce courrier electronique a ete verifiee par le logiciel antivirus Avast.
http://www.avast.com
