VBA Excel - Lister fichiers & caractéristique

Fermé
Signaler
Messages postés
1
Date d'inscription
vendredi 8 août 2008
Statut
Membre
Dernière intervention
8 août 2008
-
 liryc -
Bonjour,

J’ai une tâche à faire pour mon boulot d’étudiante en entreprise, mais comme c’est long, je voudrais utiliser une macro avec VBA pour simplifier la tâche.

En fait je dois lister dans un classeur excel tous les powerpoint (.ppt) qui sont dans les dossiers et sous-dossiers du réseau (il y en a des milliers…), avec le titre, l’emplacement (en tant que lien hypertexte si possible), la taille, et le nombre de pages (de diapos) :
Colonne A : Titre
Colonne B : Nombre de pages
Colonne C : Taille
Colonne D : Emplacement (nom complet et détaillé, mais en lien hypertexte en plus)

J’ai découvert hier VBA, et à l’aide des forums j’ai concocté cela :
______________________________________________________
Sub Importationppt()
Dim ScanFic As Office.FileSearch
Dim NomFic As Variant
Dim Diag As String
Dim Nbr As Long
Dim I As Long
Set ScanFic = Application.FileSearch
With ScanFic
.NewSearch
.LookIn = "K:\Dept LIAISONS\DLS\Dossier LS"
.SearchSubFolders = True
.Filename = "ppt"
.MatchTextExactly = True
.FileType = msoFileTypeAllFiles
Nbr = .Execute
Diag = Format(Nbr, "0 ""fichiers trouvés""")
I = 0
For Each NomFic In .FoundFiles
I = I + 1
Sheets("Feuil1").Cells(I, 1).Value = NomFic ' adapter le nom de la feuille
Next
MsgBox Diag
End With
End Sub
______________________________________________________
ça me met en fait simplement la liste des emplacements dans la colonne A… c’est tout mais déjà pas mal pour une débutante !
J’ai vu dans l’aide de Visual Basic, que DocumentProperty que l’on pouvait ajouter tout ce que je voulais, mais j’ai aucune idée de comment ça s’écrit dans le code… et alors pour paramétrer aussi mes demandes dans les colonnes correspondantes, c’est vraiment au-dessus de mes capacités de programmatrice ! ;-)

Si quelqu’un d’expérimenter pouvait m’écrire le code correspondant, ça me sauverait vraiment la vie ! sinon ce sera à la main… plus fastidieux je ne connaît pas !
Et en plus c’est pour la semaine du 11/08/08….. HELP !!
Merci d’avance !

Delphine

2 réponses

Bonjour,
Sice n'est pas trop tard ou si le sujet vous intéresse toujours, je suis prête à vous aider car je suis en retraite et j'ai fait beaucoup de VBA
Cordialement
0
Bonsoir,

au vu de vos échanges, sauriez vous me conseiller :
j'ai une feuille qui contient sur 1 colonne des noms de serveurs et sur les 4 colonnes suivantes de 1 à 4 partages existants sur le serveur de cette ligne de la 1ere colonne
Je sais "lire" les serveurs et partages (jusqu'à celulle vide)
par contre, je n'arrive pas à me dépatouiller de la problématique :
je dois compter, sur chacun des \\serveur\partage1à4 les fichiers datés de la veille et en additioner le total, par serveur, que ce soit sur une autre feuille ou non
Voilà, d'avance merci de votre réponse (même négative)
Bien cordialement
0
Bonjour,
Je me permets de venir vous solliciter, car j'ai trouvé sur un site que vous répondiez à quelqu'un pour une macro excel.
Je suis aussi à la recherche d'une macro excel permettant de:

Lister les fichiers de répertoires et sous répertoires, et d'afficher pour chaque fichier dans une colonne différente :
le nom du fichier
le chemin
la taille du fichier
la date de création ou dernière modification,
L'extension du fichier,
...

Avez-vous quelque chose qui pourrait me dépanner?
Je cous remercie par avance de l'attention que vous porterez à ma demande
SLT
AAT
amial@hotmail.fr
0
Messages postés
6917
Date d'inscription
mardi 25 septembre 2007
Statut
Membre
Dernière intervention
1 novembre 2016
1 190 > alain3741
Bonjour,

Un exemple ici : https://www.cjoint.com/?jjqeU1YwYK

Je me suis inspiré de la FAQ VB6 du site https://vb.developpez.com/

;o)
0
Messages postés
1
Date d'inscription
jeudi 10 septembre 2009
Statut
Membre
Dernière intervention
10 septembre 2009
>
Messages postés
6917
Date d'inscription
mardi 25 septembre 2007
Statut
Membre
Dernière intervention
1 novembre 2016

Polux31,
Je vous remercie bien de votre fichier, cela m’a permis de bien avancer.
J’ai effectivement récupérer ce que j’avais besoin.

J’en ai profité, sur la page de résultat (feuille2) d’ajouter une comparaison conditionnelle qui ma permis de colorier une ligne quand elle identique à celle du dessus ou du dessous (suivant le tri). De façon à trier dans les divers répertoires les fichiers similaires.

Je me retrouve maintenant avec un fichier avec parfois une ou plusieurs ligne colorié à la suite et à chaque fois une ligne normale (non coloriée).



Avez-vous une solution pour ne garder que les lignes identiques (coloriées et la ligne comparée non coloriée).

Je vous remercie par avance de votre aide.
SLT
amial@hotmail.fr
0
Bonjour, pour ma part je suis à la recherche d'une macro qui me permettrais de remonter la taille d'un dossier réseau en octet (peu importe), dans une cellule.

A ce jour j'ai trouvé çà, mais j'ai un bug et je ne sais pas pourquoi...

Sub NombreOctetsRepertoire()
Dim Rep As Object
Set Rep = CreateObject("Scripting.FileSystemObject")
Range("H3") = Rep.GetFolder("\\nom-du-serveur\").Size
End Sub
0
Bonjour,

Je dessinateur industriel sur Solid Egde et j'aurais besoins de lister les plans que j'ai créé (fichier.dft).

Je suis plus que novice dans le domaine VBA mais j'ai réussit à "créer" un code qui :
- liste les fichiers dans le dossier et sous dossiers "Z:\Mon travail\Bibliothèque\Produits intérieurs\EMH Trolleys\CH200"
- filtre le type de fichier suivant indication dans la cellule F19 (en l'occurrence .dft)
- indique la date de création
- ajout le lien hypertexte
... mais ayant des milliers de fichiers à traiter, c'est beaucoup trop long !!!
emps
Il y aurait il un moyen de réduire le t de traitement ?
(Sachant que je ne filtrer que les fichiers type .dft)

Voici le code ne question :
Option Explicit

Sub ScanClasseurs()
Dim Dossier As Object, Fichier As Object
Dim Chemin As String, CeFichier As String, ExtFichier As String
Dim TabDossiers As Variant
Dim L As Long, D As Long
Dim pos As Byte
Dim InitSB As Boolean

InitSB = Application.DisplayStatusBar
Application.DisplayStatusBar = True

Chemin = "Z:\Mon travail\Bibliothèque\Produits intérieurs\EMH Trolleys\CH200"

If Chemin = "" Then Exit Sub
Application.ScreenUpdating = False
ThisWorkbook.Sheets("ListeDFT").Range("A2:C65536").Delete Shift:=xlUp
CeFichier = ThisWorkbook.Name
ExtFichier = UCase(Trim(ThisWorkbook.Sheets("ListeDFT").Range("Extension").Text))
L = 1
'Création du tableau des sous-dossiers existants
TabDossiers = lstDossiers(Chemin, True)
For D = 1 To UBound(TabDossiers)
'Chemin du dossier (ou sous-dossier) à analyser
Chemin = TabDossiers(D)
If Right(Chemin, 1) <> "\" Then Chemin = Chemin & "\"
'Analyse du dossier (ou sous-dossier)
Set Dossier = CreateObject("Scripting.FileSystemObject").GetFolder(Chemin)
For Each Fichier In Dossier.Files
If Fichier.Name <> CeFichier Then
If ExtFichier = "" Or UCase(Right(Fichier.Name, 3)) = ExtFichier Then
'Liste les fichiers
L = L + 1
'
Application.StatusBar = "ligne traitée : " & L
'MAJ feuille résultats
With ThisWorkbook.Sheets("ListeDFT")
.Cells(L, 1).Value = Chemin
.Hyperlinks.Add Anchor:=.Cells(L, 2), Address:=Chemin & Fichier.Name, _
TextToDisplay:=Fichier.Name
.Cells(L, 3).Value = Fichier.DateCreated

End With

End If
End If
Next
Next D

Columns("B:B").Select
Range("A1:C65536").Sort Key1:=Range("B1"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A1").Select

Set Dossier = Nothing
'Rétablit l'alerte de lien éventuelle dans les options Excel
Application.ScreenUpdating = True
MsgBox L - 1 & " fichiers trouvés !"
Application.StatusBar = False
'Réinintialise le mode d'affichage de la barre.
Application.DisplayStatusBar = InitSB
End Sub

Private Function lstDossiers(Chemin As String, Optional Debut As Boolean) As Variant
Dim Dossier As Object, SD As Object, D As Object
Static TabTemp() As String
If Debut Then
ReDim TabTemp(1 To 1)
TabTemp(1) = Chemin
End If
Set Dossier = CreateObject("Scripting.FileSystemObject").GetFolder(Chemin)
'examen du dossier courant
For Each D In Dossier.subfolders
ReDim Preserve TabTemp(1 To UBound(TabTemp) + 1)
TabTemp(UBound(TabTemp)) = D.Path
Next
'Traitement récursif des sous-dossiers (d'après un code de F.Sigonneau)
For Each SD In Dossier.subfolders
lstDossiers SD.Path
Next SD
lstDossiers = TabTemp()
Set Dossier = Nothing
End Function

Merci d'avance pour vos reponses
0