XL 2016 Automatisation avec boucles et tableaux

[Tyqueb]

Bonsoir à toutes et à tous,

Je rencontre des difficultés avec un morceau de code que j'aimerai optimiser.
Mon objectif est de récupérer dans la feuille "ListeArticles" les 4 propriétés personnalisées d'environ 2000 fichiers, en fonction de la liste des fichiers qui se situe dans la colonne A de cette même feuille.
Ce code fonctionne, mais il met environ 25 secondes à s'exécuter (avec seulement 200 fichiers). Je pense qu'on peut faire beaucoup mieux avec des variables tableaux.
Après plusieurs tentatives, je suis revenu à ce qui est long mais qui fonctionne

Est ce quelqu'un aurait une idée?

Merci d'avance

Dim F As Integer
Dim debut As Date, temps As Date, fin As Date
Dim DSO As DSOFile.OleDocumentProperties
Dim D As Integer
D = Worksheets("ListeArticles").Range("A2", [A65000].End(xlUp)).Rows.Count

debut = Time

For F = 2 To D + 1

Fichier = Worksheets("ListeArticles").Range("A" & F).Value


Set DSO = New DSOFile.OleDocumentProperties

DSO.Open sfilename:=ActiveWorkbook.Path & "\Fiches articles" & "\" & Fichier
Worksheets("ListeArticles").Range("C" & F).Value = DSO.CustomProperties.Item("RefClient").Value
Worksheets("ListeArticles").Range("D" & F).Value = DSO.CustomProperties.Item("Indice").Value
Worksheets("ListeArticles").Range("E" & F).Value = DSO.CustomProperties.Item("ClientPrincipal").Value
Worksheets("ListeArticles").Range("F" & F).Value = DSO.CustomProperties.Item("Désignation").Value
DSO.Close

Next F

 

[soan]

Bonjour Tyqueb,

Juste un essai, non testé, car je n'ai pas la librairie DSO.

Sub Essai()
  If ActiveSheet.Name <> "ListeArticles" Then Exit Sub
  Dim DSO As DSOFile.OleDocumentProperties, Tbl, CF$, n&, i&, t0&
  Set DSO = New DSOFile.OleDocumentProperties
  CF = ActiveWorkbook.Path & "\Fiches articles\"
  n = Cells(Rows.Count, 1).End(3).Row: If n = 1 Then Exit Sub
  n = n - 1: Tbl = Range("A2:F" & n): t0 = Timer
  For i = 2 To n
    DSO.Open sfilename:=CF & Tbl(i, 1)
    With DSO.CustomProperties
      Tbl(i, 3) = .Item("RefClient").Value
      Tbl(i, 4) = .Item("Indice").Value
      Tbl(i, 5) = .Item("ClientPrincipal").Value
      Tbl(i, 6) = .Item("Désignation").Value
    End With
  Next i
  DSO.Close: Application.ScreenUpdating = 0: [A2].Resize(n, 6) = Tbl
  Application.ScreenUpdating = -1 'uniquement à cause du MsgBox
  'ci-dessous, car sinon, inutile : fait automatiquement juste
  'avant la sortie de la sub (par End Sub) => à enlever aussi
  'si on enlève ce Msgbox :
  MsgBox Round((Timer - t0) / 60, 2) & " minutes"
End Sub

ce code VBA suppose que dans ta colonne A, il y a les noms
de fichiers avec l'extension ; sinon, il faut l'ajouter ainsi :

DSO.Open sfilename:=CF & Tbl(i, 1) & ".xlsm"

j'ai compris que ta ligne 1 est une ligne d'en-têtes.

soan

 

[Tyqueb]

Bonjour Soan,

Merci pour ta réponse rapide et sans filet .
Les extensions sont bien comprises dans les cellules de la colonne A.
Effectivement, je n'ai pas précisé que j'avais des entêtes

J'ai placé ton code "brutalement" à la place du mien
=> Erreur "l'indice n'appartient pas à la sélection. i était à 214 alors que j'ai 214 fichiers. Dans un tableaux je crois savoir que i commence à 0, le code devait donc chercher le nom d'un 215ème fichier.
je pense avoir corrigé l'erreur en remplaçant For i = 2 To n par For i = 2 To n-1

Ensuite c'est parfait, le chrono me donne 0.01 minutes, soit 0.6 seconde pour 24 secondes auparavant.
A ceci près, que les propriétés importées sont toutes les mêmes (égales à celle du 1er fichier traité)
J'ai donc placé le Next i après la fermeture du DSO.
Je pense que la lecture des propriétés est effectuée sur le même fichier tant que nous n'avons pas fermé DSO.
Le chrono est passé à passé à 0.02 minutes soit 1.2 secondes.

Soan, ces corrections te semblent t elles les bonnes?

Un grand merci à toi pour ta solution efficace, simple et efficace.

 

[cp4]

Bonjour Soan,

Merci pour ta réponse rapide et sans filet .
Les extensions sont bien comprises dans les cellules de la colonne A.
Effectivement, je n'ai pas précisé que j'avais des entêtes

J'ai placé ton code "brutalement" à la place du mien
=> Erreur "l'indice n'appartient pas à la sélection. i était à 214 alors que j'ai 214 fichiers. Dans un tableaux je crois savoir que i commence à 0, le code devait donc chercher le nom d'un 215ème fichier.
je pense avoir corrigé l'erreur en remplaçant For i = 2 To n par For i = 2 To n-1

Ensuite c'est parfait, le chrono me donne 0.01 minutes, soit 0.6 seconde pour 24 secondes auparavant.
A ceci près, que les propriétés importées sont toutes les mêmes (égales à celle du 1er fichier traité)
J'ai donc placé le Next i après la fermeture du DSO.
Je pense que la lecture des propriétés est effectuée sur le même fichier tant que nous n'avons pas fermé DSO.
Le chrono est passé à passé à 0.02 minutes soit 1.2 secondes.

Soan, ces corrections te semble t elle les bonnes?

Un grand merci à toi pour ta solution efficace, simple et efficace.

Bonjour Tyqueb, Soan,

En l'absence de soan, je me permets d'apporter ma contribution.
Dans ton cas le tableau commence à 1, je pense que le problème vient du n=n-1 et du i qui doit commencer à 1. Ci-dessous code corrigé à tester.

Sub Essai()
  If ActiveSheet.Name <> "ListeArticles" Then Exit Sub
  Dim DSO As DSOFile.OleDocumentProperties, Tbl, CF$, n&, i&, t0&
  Set DSO = New DSOFile.OleDocumentProperties
  CF = ActiveWorkbook.Path & "\Fiches articles\"
  n = Cells(Rows.Count, 1).End(3).Row: If n = 1 Then Exit Sub
  'n = n - 1: 
Tbl = Range("A2:F" & n): t0 = Timer
  For i = 1 To n
    DSO.Open sfilename:=CF & Tbl(i, 1)
    With DSO.CustomProperties
      Tbl(i, 3) = .Item("RefClient").Value
      Tbl(i, 4) = .Item("Indice").Value
      Tbl(i, 5) = .Item("ClientPrincipal").Value
      Tbl(i, 6) = .Item("Désignation").Value
    End With
  Next i
  DSO.Close: Application.ScreenUpdating = 0: [A2].Resize(n, 6) = Tbl
  Application.ScreenUpdating = -1 'uniquement à cause du MsgBox
  'ci-dessous, car sinon, inutile : fait automatiquement juste
  'avant la sortie de la sub (par End Sub) => à enlever aussi
  'si on enlève ce Msgbox :
  MsgBox Round((Timer - t0) / 60, 2) & " minutes"
End Sub

Bonne journée.

 

[soan]

Bonjour Tyqueb, cp4,

désolé pour avoir tardé à répondre, j'étais occupé par des affaires persos.

merci @cp4 pour avoir apporté ta contribution.

je ne crois pas que i soit en cause : il est défini ainsi : Dim i&
comme c'est le type Long, le nombre de fichiers 214 tient très bien
dans la plage des entiers longs !

i ne peut pas commencer à 0 car la boucle est : For i = 2 To n

-------------------------------------------------------------------------------

comme tu as une ligne d'en-têtes, c'est pour ça que j'ai mis :
Tbl = Range("A2:F" & n) : à partir de A2, et non A1.

c'est là que je viens de voir que j'ai fait une erreur ; heureusement,
cp4 l'a correctement corrigée : ça devrait mieux marcher avec :
For i = 1 To n ; et non pas à partir de 2.

je m'en serais sûrement rendu compte aussitôt si j'avais pu tester
ma macro, mais sans la librairie DSO, impossible !

-------------------------------------------------------------------------------

par contre, je pense qu'il faut laisser le n = n - 1 ; et ne pas le
mettre en commentaire, comme l'a fait cp4 ; ceci car au départ,
n est le n° de la dernière ligne utilisée ; et sans compter la ligne
d'en-têtes, le tableau Tbl comporte bien n - 1 éléments.

bien noter aussi que si le tableau est vide et donc ne comporte
aucune donnée, n vaudra 1 car la ligne d'en-tête est la ligne
n° 1, or si n = 1 on quitte la sub : If n = 1 Then Exit Sub

-------------------------------------------------------------------------------

je pense que oui, tu as très bien fait de placer le Next i après
la fermeture du DSO ; ainsi, les propriétés importées ont dû
être correctes pour chaque fichier ; j'avais placé la fermeture
après la boucle car je pensais que c'était un même DSO pour
tous les fichiers ; et dans ce cas, une seule fermeture aurait
suffit au lieu d'une fermeture pour chaque fichier.

-------------------------------------------------------------------------------

j'espère que cette fois, tout sera ok !

soan

 

[Tyqueb]

je m'aperçois que j'avais oublié un bout de mes corrections ce matin.
J'avais bien fait la correction For i = 2 To n devient For i = 1 To n (contrairement à ce que je dis à 9h29 )
Par contre, ca a corrigé le manque des propriétés sur le 1er fichier traité, c'est à dire que les colonnes C, D, E et F n'étaient remplies qu'à partir de la ligne 3.
Ce qui a corrigé " l'indice n'appartient pas à la sélection " c'est bien l'ajout de -1 après le n. ca me donne donc For i = 1 To n-1

comme cela tout fonctionne parfaitement, en très peu de temps. (1,2 secondes)

 

[soan]

@Tyqueb

ben oui, si tu as laissé en commentaire n = n - 1 il faut bien sûr
« compenser » en mettant For i = 1 To n - 1 ; mais si j'ai préféré
faire avec n = n - 1 il y a une raison ; je te laisse la trouver.

soan

 

[Tyqueb]

Mais je n'ai pas mis n = n - 1 en commentaire, justement.

 

[soan]

ah, bon ; ben alors j'te laisse continuer et explorer avec ta librairie DSO ;
moi, j'suis pas trop en mesure de t'aider davantage là-dessus !

soan

 

[Tyqueb]

Pour moi l'objectif est atteint. (et sans fichier fourni ☝ ) chapeau
Merci pour votre aide