Discussion :

[tioch]

Bonjour à tous,

Voila ma situation : j'ai un dossier contenant de nombreux fichiers Excel, chacun d'ux contenant de nombreuses données. Un dernier fichier a été créé afin de synthétiser toutes les données de tous ces fichiers (j'espere que je me fais bien comprendre).
Ainsi lors du démarage, la mise a jour du fichier synthèse est très (très) longue. Je voudrais diminuer ce temps.
Mon idée était donc de créer un programme qui vérifie la date de modification de chaque fichier et ainsi si elle est supérieure à la précédente mise a jour, la modification dans fichier synthèse se fait, sinon rien ne se passe et on gagne ainsi du temps.

Deja est-ce que vous pensez que ca marcherait?
Et si oui, quelqu'un aurait une piste ou complètement une macro? Où quelles fonctions je pourrait utiliser?

J'espère que je me suis bien fait comprendre sinon demander moi de réexpliquer.

Merci d'avance

Tioch

[MarcelG]

Bonjour Tioch,

Je ne prétends pas avoir la solution toute faîte.
Cependant, je soumets cette procédure à l'aval de mes chers collègues plus compétents

L'idée

1 - Alimenter une variable Tableau selon le critère de date de création du classeur

2 - Mettre à jour par VBA la(les) liaison(s) suivant ce tableau

ce qui donnerait un code de ce type (pas testé)
(ne pas oublier d'activer la référence Microsoft indiquée)

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
46
47
Sub listeFichiersXLS_Repertoire()
Dim Dossier As String
 
Dossier = "LECHEMINCOMPLET"
 
'indiquer False pour ne pas rechercher dans les sous repertoires
ListFilesInFolder Dossier, True
 
End Sub
 
Sub ListFilesInFolder(SourceFolderName As String, IncludeSubfolders As Boolean)
' adapté de Ole P Erlandsen
'necessite d'activer la reference Microsoft Scripting RunTime
Dim Fso As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder
Dim SubFolder As Scripting.Folder
Dim FileItem As Scripting.File
Dim i As Long
Dim tabloliens() As String
 
Set Fso = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = Fso.GetFolder(SourceFolderName)
 
i = 0
 
For Each FileItem In SourceFolder.Files
 
        With FileItem
 
                If .Type = "Microsoft Excel Worksheet" And .DateLastModified > CDate("30/04/11") Then
                        i = i + 1
                        ReDim Preserve tabloliens(1 To i)
                        tabloliens(i) = ThisWorkbook.Path & "\" & .Name
                End If
 
        End With
 
Next FileItem
 
'Pour éviter les liaisons inexistantes
On Error Resume Next
 
For i = 1 To UBound(tabloliens)
    ThisWorkbook.UpdateLink Name:=tabloliens(i), Type:=xlExcelLinks
Next
 
End Sub

Je pense que c'est une voie.

Salut à tous,

En complément, on peut lister les documents liés à un classseur.

Voir

liste des documents liés

Et tester la date de création pour en mettre à jour la liaison.

Une autre voie.

[tioch]

Merci MarcelG de tes réponses.
Mais je ne comprends pas très bien où tu veux en venir et ce que tu veux faire.
Pourquoi veux tu créer un tableau alors que j'en ai deja un?
J'ai deja un code qui remplit le tableau. Mon but est lors de la mise a jour, le programme ne re-remplisse que les lignes (chaques lignes correspondant à un fichier excel) qui ont été modifiées depuis la dernière mise a jour.

Merci encore, c'est grace à des gens comme toi que ca avance

Tioch

[MarcelG]

Bonjour tioch,

Il ne faut pas confondre une variable tableau qui est une variable VBA, virtuelle, avec un tableau Excel.

Cette variable tableau serait ici alimentée par les classeurs dont la date de création répond à un critère (voir le code).

Dans un 2ème temps, la mise à jour des liaisons s'effectuerait en relation avec les seuls classeurs figurant dans ce tableau.

Je soumets humblement cette proposition à mes collègues du Forum.

Salut Tioch,

En combinant ce qui précède

Au préalable, dans le code ci-dessous, adapter :
- le chemin complet du répertoiire à tester, ici Dossier
- la date plancher, ici

De plus, activer la référence Microsoft indiquée

Je propose à la communauté (pas testé)

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
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
Sub Maj_liaisons_Repertoire()
Dim Dossier As String
 
Dossier = "LECHEMINCOMPLET"
 
'indiquer False pour ne pas rechercher dans les sous repertoires
ListFilesInFolder Dossier
 
End Sub
 
Sub ListFilesInFolder(SourceFolderName As String)
' adapté de Ole P Erlandsen
'necessite d'activer la reference Microsoft Scripting RunTime
Dim Fso As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder
Dim SubFolder As Scripting.Folder
Dim FileItem As Scripting.File
Dim i As Long
Dim tablo() As String
 
Dim TabLiaisons As Variant
Dim x As Integer
 
Dim trouve As Boolean
 
'Renvoie un tableau de TabLiaisons
TabLiaisons = ThisWorkbook.LinkSources
 
Set Fso = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = Fso.GetFolder(SourceFolderName)
 
i = 0
 
For Each FileItem In SourceFolder.Files
 
        With FileItem
 
                If .Type = "Microsoft Excel Worksheet" And .DateLastModified > CDate("30/04/11") Then
                        i = i + 1
                        ReDim Preserve tablo(1 To i)
                        tablo(i) = ThisWorkbook.Path & "\" & .Name
                End If
 
        End With
 
Next FileItem
 
For i = 1 To UBound(TabLiaisons)
    trouve = faux
    For x = 1 To UBound(tablo)
        If TabLiaisons(i) = tablo(x) Then
            trouve = True
            Exit For
        End If
     Next
    If trouve = True Then _
            ThisWorkbook.UpdateLink Name:=TabLiaisons(i), Type:=xlExcelLinks
Next
 
Set Fso = Nothing
Set SourceFolder = Nothing
 
Erase tablo
Erase TabLiaisons
 
End Sub

[tioch]

C'est cool d'avoir réalisé cette macro. J'ai essayé de la testé su mon tableau. Excel me dit qu'il un bug sur la ligne

Code :

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

ThisWorkbook.UpdateLink Name:=TabLiaisons(i), Type:=xlExcelLinks

que

la méthode 'Updatelink' de l'objet '_Workbook' a échoué

Donc si tu sais quel est le problème. Ca serait vraiment cool que ca marche.
Je te passe un exemple (en gros) de dossier que je dois traiter (les originaux étant classés confidentiels) pour que tu te fasses une idées.

Encore une fois merci

[MarcelG]

Salut Tioch,

Essaie d'ouvrir ton classeur sans activer les liaisons.

Après avoir activé l'enregistreur de macros, mets à jour manuelement une liaison.

Arrête l'enregistrement.

Dans le dernier code ajoute

Code :

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

1
2
3
4
5
6
7
8
If trouve = True Then :
'Mettre cette ligne - précédente - en libellé            
'ThisWorkbook.UpdateLink Name:=TabLiaisons(i), Type:=xlExcelLinks
 
'Ces 2 lignes
 
Debug.Print TabLiaisons(i)
Debug.Print tablo(x)

Regarde s'il ya une homogénéité, notamment dans le répertoire, entre le résultat de l'enregistrement de ta macro ci-dessus (enregistreur) et ta fenêtre Exécution.

Peut-être une question de chemin.