lire un repertoire en ligne ?

sioli

XLDnaute Nouveau
bonjour a tous

comme je ne connait tres bien l'anglais et que les commendent en vba son en anglais bien si s'est possible avoir de l'aide par des chercheur que vous ete.

voilas : je voidrais afficher dans la colonne " a " le non du repertoire puis dans la colonne b,c,d,e,etc tous se qui se trouve dans le repertoire

repeter chaque fois qu'il y auras un repertoire

ex: a1 le repertoire b1,c1,d1 etc les fichiers qui son dans le repertoire
a2 s'il y a un autre repertoire
a3 unsi de suite j'usque quand il n'y a plus de repertoire

ex plus claire : j'ai le c:/photos/lundi/ les photos du lundi
mardi/ " " mardi
mercredi/" " etc..

merci a tous et pour ne pas mourir idiot

si posible une petite explication serais la bien venu s'est comme sa con apprend

encore merci a tous.
 

JCGL

XLDnaute Barbatruc
Re : lire un repertoire en ligne ?

Bonjour à tous,
Salut Tatiak le Maudit (Private Joke :))

Un lien vers un petit fichier réalisé grâce à Ti :) et Michel XLD

Un click sur le Grand GO pour commencer

Ce lien n'existe plus

Bon Dimanche à toutes et tous
 

didus

XLDnaute Occasionnel
Re : lire un repertoire en ligne ?

Salut,

Ceci est une autre extraction possible qui donne la liste des fichiers et un lien pour chacun en laissant à l'utisateur le choix du type de fichier et du répertoire.


Sub lien_hypertext_liste_fichiers()
'
' lien_hypertext_liste_fichiers Macro
' Macro enregistrée le 13/01/2007 par didus
'

Dim mess As String, mess2 As String, répertoire As String
Columns(1).Clear
Columns(2).Clear
mess = InputBox("Chemin complet du répertoire à explorer, attention, / à la fin", "Chemin du répertoire", _
"G:\gimr\")
mess2 = InputBox( _
"Donnez seulement le type de fichier (par exemple pdf, xls, doc, jpg ou dxf etc...)" _
, "TYPE DE FICHIER", "pdf")
Application.ScreenUpdating = False
répertoire = Dir(mess & "*" & mess2, vbDirectory)
Do While répertoire <> ""
i = i + 1
Cells(i, 1) = répertoire
ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 2), Address:=mess & répertoire
Cells(i, 2) = mess & répertoire
répertoire = Dir
Loop
End Sub

Ce code n'est pas totalement de ma compo, je me suis inspiré de certains posts, mais si cela peut être utile...

amitiés
 

sioli

XLDnaute Nouveau
Re : lire un repertoire en ligne ?

merci pour ce petit programme

Sub lien_hypertext_liste_fichiers()
'
' lien_hypertext_liste_fichiers Macro
' Macro enregistrée le 13/01/2007 par didus
'

Dim mess As String, mess2 As String, répertoire As String
Columns(1).Clear
Columns(2).Clear
mess = InputBox("Chemin complet du répertoire à explorer, attention, / à la fin", "Chemin du répertoire", _
"D:\__test\389_ar_std\")
mess2 = InputBox( _
"Donnez seulement le type de fichier (par exemple pdf, xls, doc, jpg ou dxf etc...)" _
, "TYPE DE FICHIER", "jpg")
Application.ScreenUpdating = False
répertoire = Dir(mess & "*" & mess2, vbDirectory)
Do While répertoire <> ""
i = i + 1
Cells(1, i) = répertoire
ActiveSheet.Hyperlinks.Add Anchor:=Cells(1, i), Address:=mess & répertoire
'Cells(i, 2) = mess & répertoire
répertoire = Dir
Loop
End Sub


je l'ai modifier un peu mais il m'affiche en a1 le chemin complet du repertoire.

en a2 jusque fin des images qui ce trouve dans le repertoire .

je m'explique :

c:/2001/montagne/il y a 5 photos
/mere/il y a 6 photos
/campigue/ il y a 5 photos

a1 a2 a3 a4 a5 a6 a7
c:/2001/motagne image1 image2 image3 image4 image5
c:/2001/mere image1 image2 image3 image4 image5 image6
c:/2001/campgue image1 image2 image3 image4 image5


jusqu'au moment ou il n'y a plus de repertoire en 2001

merci a tous
 

MJ13

XLDnaute Barbatruc
Re : lire un repertoire en ligne ?

Bonjour à tous

Comment modifier la macro du fichier dir.zip pour ne lister qu'un type de fichier particulier (Ex pdf) ?

Surement avec:

Code:
right

ex:

Code:
if right (NomFichier,3) ="PDF" then

Attention à la casse, peut être ajouter ucase pour mettre en majuscule :).

Ce qui donnerait:

Code:
Sub test()
Dim Dossier As String
    Dossier = ActiveWorkbook.Path
    ListFilesInFolder Dossier, True
End Sub
Sub ListFilesInFolder(strFolderName As String, bIncludeSubfolders As Boolean)
' adapté de Ole P Erlandsen
' necessite d'activer la reference Microsoft Scripting RunTime
Static FSO As FileSystemObject
Dim oSourceFolder As Scripting.Folder
Dim oSubFolder As Scripting.Folder
Dim oFile As Scripting.File
Static wksDest As Worksheet
Static iRow As Long
Static bNotFirstTime As Boolean
    If Not bNotFirstTime Then
        Set wksDest = ActiveSheet
        Set FSO = CreateObject("Scripting.FileSystemObject")
        wksDest.Cells(2, 1) = "Dossiers"
        wksDest.Cells(2, 2) = "Noms des Fichiers"
        iRow = 3
        bNotFirstTime = True
    End If
    Set oSourceFolder = FSO.GetFolder(strFolderName)
    On Error Resume Next
    For Each oFile In oSourceFolder.Files
    'MsgBox oFile.Name
    If UCase(Right(oFile.Name, 3)) <> "PDF" Then GoTo suite
        wksDest.Cells(iRow, 1) = oFile.ParentFolder.Path
        wksDest.Cells(iRow, 2) = oFile.Name
iRow = iRow + 1
suite:
    Next oFile
    If bIncludeSubfolders Then
        For Each oSubFolder In oSourceFolder.SubFolders
            ListFilesInFolder oSubFolder.Path, True
        Next oSubFolder
    End If
End Sub
 
Dernière édition:

didus

XLDnaute Occasionnel
Re : lire un repertoire en ligne ?

Bonjour à tous,

La macro que j'ai posté le fait déjà,
Elle pose la question du choix de l'extension à extraire, ce qui permet de pouvoir moduler à l'infini le répertoire à sonder et le type de fichiers à lister.

cordialement
 

Statistiques des forums

Discussions
312 389
Messages
2 087 925
Membres
103 676
dernier inscrit
Haiti