recherche de xls selon auteur

[beatrice2fr]

bonjour
Tout d'abord, j'espere etre au bon forum pour les vba.
Etant debutante dans ce domaine, je m'adresse a vous pour m'aider a resoudre mon probleme.
je voudrai par macro rechercher dans un repertoire ( Mes documents) ainsi que dans les dossiers qui y sont stockés, tous les xls d'un meme auteur (toto). J'ai recupéré le code ci apres, mais je n'arrive pas a l'adapter a mes besoin, car il ne cherche pas dans les sous dossiers et au lieu de m'afficher le nom de tous les auteurs, il faudrai qu'il lance la macro1, pour seulement les xls de "toto".
j' espere etre suffisement precise, en vous remerciant d'avance pour vos suggestions

Sub proprietesFichiers()
'
'Necessite d'activer la reference Microsoft Shell Controls and Automation
'
Dim objShell As Object, strFileName As Object
Dim objFolder As Folder
Dim Resultat As String
Dim i As Byte
 
Set objShell = CreateObject("Shell.Application")

Set objFolder = objShell.Namespace("C:\Documents and Settings\Mes documents")
For Each strFileName In objFolder.Items
    If strFileName.isFolder = False Then
    Resultat = ""
        For i = 9 To 9
        Resultat = Resultat & objFolder.getDetailsOf(strFileName, i) & vbLf
        Next
    MsgBox Resultat
    End If
Next
End Sub

 

[beatrice2fr]

Re : recherche de xls selon auteur

oui en effet ca ne correspond pas merci qq meme

 

[YANN-56]

Re : recherche de xls selon auteur

Bonjour Béatriste,
Crotte !!! Béatrice voulais-je dire.

Regarde le fichier joint,
peut-être pourras-tu en tirer quelque chose.

Amicalement et respectueusement;
bonne fin de journée.

YANN-56

 

[beatrice2fr]

Re : recherche de xls selon auteur

bonjour bonjour yann-56
je te remercie pour ton lien , il m'est tres interressant. Ceci dit comme je l'ai dit au debut , je ne connais pas grand chose en vba, et je n'ai pas été capable de le modifier a mes besoins.... ( Ce n'est pas faute d'avoir essayer)
Donc je te sollicite, ainsi que le forum, pour ceretaine modif.
- chercher aussi dans les sous dossiers
- lancer la Macro1 si l'auteur est "toto"

merci de votre aide

 

[MJ13]

Re : recherche de xls selon auteur

Bonjour Beatrice, Yann,

Peut-être ce lien pourra t'aider

https://www.excel-downloads.com/threads/recuperer-noms-de-dossier-et-de-fichier.61963/

 

[YANN-56]

Re : recherche de xls selon auteur

bonjour bonjour yann-56
je te remercie pour ton lien , il m'est tres interressant. Ceci dit comme je l'ai dit au debut , je ne connais pas grand chose en vba, et je n'ai pas été capable de le modifier a mes besoins.... ( Ce n'est pas faute d'avoir essayer)
Donc je te sollicite, ainsi que le forum, pour ceretaine modif.
- chercher aussi dans les sous dossiers
- lancer la Macro1 si l'auteur est "toto"

merci de votre aide

Je l'ai fait par ailleurs,
il faut que je le retrouve!!!
Promis; je m'y mets.

A plus tard, et bonne soirée.

YANN-56 (MORBIHAN Of course)

 

[PMO2]

Re : recherche de xls selon auteur

Bonjour,

Une piste avec les codes suivants à copier dans un module standard

'/////////////////////////////////////////////////
'///  Nécessite les références aux librairies  ///
'///                                           ///
'/// Library IWshRuntimeLibrary                ///
'/// C:\WINDOWS\system32\wshom.ocx             ///
'/// Windows Script Host Object Model          ///
'///                                           ///
'/// Library Shell32                           ///
'/// C:\WINDOWS\system32\SHELL32.dll           ///
'/// Microsoft Shell Controls And Automation   ///
'/////////////////////////////////////////////////

'###############################################
'### Constante du dossier éligible à adapter ###
Const DOSSIER As String = "C:\0\Mes bidouilles"
'### Constante de l'auteur du .xls à adapter ###
Const AUTEUR As String = "Patrick Morange"
'###############################################

Const AUTHOR As Long = 9
Dim TabDossier()
Dim nbFolders&

'________________________________________
Sub FichiersXlsDansDossiers()
Dim FSO As IWshRuntimeLibrary.FileSystemObject
Dim F As IWshRuntimeLibrary.Folder
Set FSO = CreateObject("Scripting.FileSystemObject")
Set F = FSO.GetFolder(DOSSIER)
If Len(Trim(DOSSIER)) < 4 Then Exit Sub
nbFolders& = nbFolders& + 1
ReDim TabDossier(1 To nbFolders&)
TabDossier(nbFolders&) = DOSSIER
Call EnumereSousDossier(F)
Set F = Nothing
Set FSO = Nothing
Call PropertyAuthorXLS
nbFolders& = 0
End Sub
'________________________________________
Sub EnumereSousDossier(F As IWshRuntimeLibrary.Folder)
Dim SubFolder As IWshRuntimeLibrary.Folder
For Each SubFolder In F.SubFolders
  nbFolders& = nbFolders& + 1
  ReDim Preserve TabDossier(1 To nbFolders&)
  TabDossier(nbFolders&) = SubFolder.Path
  '--- Récursivité pour les sous-dossiers ----
  Call EnumereSousDossier(SubFolder)
Next SubFolder
Set SubFolder = Nothing
End Sub
'________________________________________
Sub PropertyAuthorXLS(Optional dummy As Byte)
Dim SH As Shell32.Shell
Dim F As Shell32.Folder
Dim FI As Shell32.FolderItem
Dim T()
Dim i&
Dim j&
Set SH = CreateObject("Shell.Application")
For i& = 1 To UBound(TabDossier)
  Set F = SH.Namespace(TabDossier(i&))
  For Each FI In F.Items
    If Not FI.isFolder Then
      If LCase(Right(FI.Name, 4)) = ".xls" Then
        If F.getDetailsOf(FI, AUTHOR) = AUTEUR Then
          j& = j& + 1
          ReDim Preserve T(1 To 3, 1 To j&)
          T(1, j&) = FI.Path
          T(2, j&) = FI.Name
          T(3, j&) = F.getDetailsOf(FI, AUTHOR)
        End If
      End If
    End If
  Next FI
Next i&
If j& > 0 Then

  '--- Inscription des résultats dans une nouvelle feuille ---
  Sheets.Add
  Range(Cells(1, 1), Cells(UBound(T, 2), UBound(T, 1))) = Application.WorksheetFunction.Transpose(T)
  '--- ou alors votre traitement ... ???
  'Ma Macro
  
Else
  MsgBox "Aucun classeur de l'auteur ''" & AUTEUR & "'' n'a été trouvé."
End If
Set FI = Nothing
Set F = Nothing
Set SH = Nothing
End Sub

1) Les références aux librairies IWshRuntimeLibrary et Shell32 sont indispensables.
2) Adaptez, à votre usage, les constantes cernées par des dièses (###)

Lancez la macro FichiersXlsDansDossiers qui inscrira, dans une nouvelle feuille, tous les .xls de l'auteur défini.
Comme je ne sais pas ce que fait votre Macro1 à vous d'adapter le code.

Cordialement.

PMO
Patrick Morange

 

[beatrice2fr]

Re : recherche de xls selon auteur

Bonjour
Tout d'abord merci a tous pour votre aide
j'ai trouvé ( dans les super classeur de J B ) ce code qui est tres efficace ( et un peu plus court que le tien PMO2 ).
cependant je voudrai executer Macro1 pour tous les resultats et non les afficher en MsgBox.

Sub essai233()
   Author = "toto"
   masque = "*.xls*"
   repertoire = "C:\"
   If Author <> "" Then
     RechercheAuthor repertoire, Author, masque
   End If

End Sub

Sub RechercheAuthor(chemin, Author, masque)
    Dim FS, I As Integer
    Set FS = Application.FileSearch
    FS.NewSearch
    FS.LookIn = chemin
    FS.SearchSubFolders = True
    FS.TextOrProperty = Author
    FS.Filename = masque
    FS.MatchTextExactly = False
    If FS.Execute > 0 Then
      For I = 1 To FS.FoundFiles.Count
        MsgBox Application.FileSearch.FoundFiles(I)
      Next I
    End If
End Sub

 

[YANN-56]

Re : recherche de xls selon auteur

Bonsoir Béatrice,

J'ai quitté le fil car je te vois entre de bonnes mains.

En cas d'échec dont je doute;

Dans un Message personnel, tu me fais signe.
Je pourrai tenter de te construire un truc.

Amicalement,
avec mes compliments aux intervenants

Bonne soirée à tous

YANN-56

P.S.
Attention à "Application.FileSearch"
qui,à ce que j'ai cru comprendre, n'est plus utilisable
avec les dernières versions d'Excel !!!

 

[beatrice2fr]

Re : recherche de xls selon auteur

Je te remercie Yann. ceci dit peut etre que tu peut encore m'aider sur

cependant je voudrai executer Macro1 pour tous les resultats et non les afficher en MsgBox.

 

[PMO2]

Re : recherche de xls selon auteur

Bonjour,

Il faudrait que nous sachions ce que fait votre Macro1. Nécessite-t-elle d'ouvrir chaque classeur OU se contente-t-elle d'en modifier les propriétés OU ... ?
Pouvez-vous la faire paraître pour pouvoir en voir son effet et nous fournir quelques explications quant à son usage.

D'autre part, YANN-56 confirme ce que je subodorais en ce qui concerne l'invalidité de FileSearch sur Excel 2007.

Cordialement.

PMO
Patrick Morange

 

[beatrice2fr]

Re : recherche de xls selon auteur

re
Ben Macro1 a pour but de regrouper tout les classeurs utilisés dans le meme dossiers, car ceux ci sont souvent deplacer par les differents utilisateurs. Toutefois a la lecture de votre intervention PMO2 je realise qu'une macro de ce type peut effectivement etre utiliser de facon a nuire au travail d'autrui . Ceci n'etant pas mon objectif ( quoi que vous me dirai que rien ne le prouve) je ne me sens pas concerner par le dernier "OU ... ?" de votre interrogation, quoi qu'elle soit toute a fait légitime.

j'ai donc ecrit Macro1 (que je n'ai pas pu tester) qui doit selectionner les classeurs trouvé et les envoyer vers le dossier "TOUS"

Sub Macro1()
'
Dim objFolder As Folder

    Workbooks.Select
    Selection.Copy
   Set objFolder = objShell.Namespace("C:\Documents and Settings\Bureau\TOUS")
    ActiveSheet.Paste
    
End Sub

 

[PMO2]

Re : recherche de xls selon auteur

Bonjour,

Essayez avec la nouvelle pièce jointe.

Cordialement.

PMO
Patrick Morange