Discussion :

[GROBIN]

Bonjour,
Comme beaucoup, j'essaie d'adapter une macro qui fonctionne sous excel 2003 adaptée d'un exemple
trouver, en son temps, sur la facq mais non réactualisée, à excel 2010.
J'ai lu le document de SilkyRoad, téléchargé les fichiers; coché dans macro complémentaire Classefilesearch
et dans VBAProject ClFileSearch. Dans mon code, j'ai remplacé FileSearch par ClasseFileSearch.
Pourtant ma macro ne fonctionne toujours pas
Cette macro sert à compter le nombre de photos se trouvant dans un fichier placé sur le bureau

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub ListerUnRépertoire()
Set fs = Application.ClasseFileSearch
    With fs
        .LookIn = "C:\Users\Annecy\Desktop\Base\"
        .FileType = msoFileTypeAllFiles
        If .Execute(SortBy:=msoSortByFileName, _
        SortOrder:=msoSortOrderAscending) > 0 Then
            MsgBox "Ce dossier contient " & .FoundFiles.Count & _
                " fichier(s) répondant aux critères."
            For i = 1 To .FoundFiles.Count
                If Right(LCase(.FoundFiles(i)), 4) = ".jpg" Then _
                    MsgBox i '.FoundFiles(i)
            Next i
           Else
            MsgBox "Aucun fichier n'a été trouvé."
        End If
    End With
End Sub

Je vous remercie de vous pencher sur mon problème
Bien cordialement - GROBIN

[clementmarcotte]

Bonjour,

Pour peu que j'ai pu voir, le complément de SilkyRoad n'est pas basé sur le modèle d'Objets d'Office, mais sur celui de la bibliothèque Scripting; en fait c'est le Scripting.FileSystemObject. Donc, tu ne peux pas utiliser les constantes d'Office (msoquelquechose), que le complément de SilkyRoad ne reconnaît pas et n'utilise pas.

À mon humble avis tu dois abandonner cette macro et la réécrire au complet.

Tu peux prendre cette macro du tutoriel, qui devrait passer sans problème dans Excel 2010, comme canevas initial:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
Sub Test()
'Nécessite d'activer la référence ClFileSearch
'(Dans l'éditeur de macros: Menu Outils/Références)
Dim i As Long
Dim Recherche As ClFileSearch.ClasseFileSearch
 
 
Set Recherche = ClFileSearch.Nouvelle_Recherche
 
With Recherche
    'Définit le répertoire de recherche
    .FolderPath = "C:\Documents and Settings\mimi\NomDossier"
 
    'Définit la recherche dans les sous dossiers (True / False)
    .SubFolders = False
 
    'Option de tri:
    '(Sort_None, sort_Name, sort_Path, sort_Size, sort_DateCreated, sort_LastModified, sort_Type)
    'Pas de tri si le paramètre n'est pas spécifié.
    .SortBy = sort_Name
 
     'Option pour rechercher un type de fichier
    '(Renvoie tous les fichiers si non spécifié)
    '.Extension = "*.doc"
 
    'Execute la recherche
    .Execute
 
    'Boucle sur le tableau pour afficher le résultat de la recherche
    '(.FoundFilesCount renvoie le nombre de fichiers trouvés)
    For i = 1 To .FoundFilesCount
        Debug.Print .Files(i).strFileName 'nom du fichier
        Debug.Print .Files(i).strPathName 'chemin
        Debug.Print .Files(i).lngSize & "  octets" 'taille
        Debug.Print .Files(i).DateCreated 'date création fichier
        Debug.Print .Files(i).DateLastModified 'date dernière modification
        Debug.Print .Files(i).strFileType 'type de fichier
 
        Debug.Print "---"
    Next
End With
 
Set Recherche = Nothing
 
End Sub

Enlève le commentaire et change ".doc" pour ".JPG" dans cette ligne:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

  '.Extension = "*.doc"

[kiki29]

Salut, peut-être en adaptant ceci à ton contexte ?

[GROBIN]

Bonjour clementmarcotte. Merci pour ta réponse. Avec ce code, j'obtiens en effet le décompte des photos. Je reviens vers toi dans quelques jours car, j'ai d'autres macros à adapter je vais voir si ça "colle" et mettrai résolu si c'est le cas
Bonjour kiki29 j'ai téléchargé le fichier "Liste_Fichiers" mais, à l'ouverture, j'ai un message

erreur de compilation. Le code contenu dans ce projet doit être mise à jour pour être utilisé sur les système 64bits. Vérifier et mettez à jour les instructions Declare, puis marquez les avec l'attribut PtrSafe

. Quid? Vu mes connaissances, je nage. Merci de ta réponse
Bien cordialement à vous deux. GROBIN

[kiki29]

Salut, peut-être car Office 64 bits ? voir ici
Dans ce cas modifier comme ceci ( sans garantie de ma part car pas d'Office 64 bits pour le vérifier )

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
 #If Win64 Then
    Private Declare PtrSafe Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
    Private Declare PtrSafe Function FindFirstFile Lib "kernel32" _
            Alias "FindFirstFileA" _
            (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
    Private Declare PtrSafe Function FindNextFile Lib "kernel32" _
            Alias "FindNextFileA" _
            (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
    Private Declare PtrSafe Function lstrlen Lib "kernel32" Alias "lstrlenW" (ByVal lpString As LongPtr) As Long
    Private Declare PtrSafe Function PathMatchSpec Lib "shlwapi" _
            Alias "PathMatchSpecW" _
            (ByVal pszFileParam As LongPtr, ByVal pszSpec As LongPtr) As LongPtr
#Else
    Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
    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 Declare Function lstrlen Lib "kernel32" Alias "lstrlenW" (ByVal lpString As Long) As Long
    Private Declare Function PathMatchSpec Lib "shlwapi" _
            Alias "PathMatchSpecW" _
            (ByVal pszFileParam As Long, ByVal pszSpec As Long) As Long
#End If

[clementmarcotte]

Bonjour,

Salut, peut-être car Office 64 bits ? voir ici
Dans ce cas modifier comme ceci ( sans garantie de ma part car pas d'Office 64 bits pour le vérifier )

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
 #If Win64 Then
    Private Declare PtrSafe Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
    Private Declare PtrSafe Function FindFirstFile Lib "kernel32" _
            Alias "FindFirstFileA" _
            (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
    Private Declare PtrSafe Function FindNextFile Lib "kernel32" _
            Alias "FindNextFileA" _
            (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
    Private Declare PtrSafe Function lstrlen Lib "kernel32" Alias "lstrlenW" (ByVal lpString As LongPtr) As Long
    Private Declare PtrSafe Function PathMatchSpec Lib "shlwapi" _
            Alias "PathMatchSpecW" _
            (ByVal pszFileParam As LongPtr, ByVal pszSpec As LongPtr) As LongPtr
#Else
    Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
    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 Declare Function lstrlen Lib "kernel32" Alias "lstrlenW" (ByVal lpString As Long) As Long
    Private Declare Function PathMatchSpec Lib "shlwapi" _
            Alias "PathMatchSpecW" _
            (ByVal pszFileParam As Long, ByVal pszSpec As Long) As Long
#End If

Voici une version 64 bits de ta macro "faite" et testée sur un Excel 2010 64 bits. J'espère que je ne regretterai pas de l'avoir enregistrée au format xlsm.

Je te laisse le soin de décider de l'ajouter, ou non, au site, ou de remplacer ton classeur par celui-ci.

[kiki29]

Salut Clément et merci pour ton code, car à ce jour je n'ai pas d'Office 64 Bits pour tester quoi que soit.Je vais rajouter cela dans la rubrique téléchargement.

[GROBIN]

Bonjour à tous
Sincèrement, merci pour votre aide
GROBIN