[XL-2007] Code pour fermer un fichier dont on connaît le lien

[kl1ft]

Bonjour,

j'aimerais un petit bout de code pour fermer un fichier (pdf / word / etc...) dont je connais le lien ("C:\...\fichier.extension").

J'ai cherché sur internet mais je n'ai pas trouvé grand chose (forum anglais / français...)

Si vous avez ça sous la main, je suis preneur... merci d'avance


kl1ft

[Theze]

Bonsoir,

Voilà un truc un peu alambiqué mais bon, j'ai pas pû faire mieux
Lance la proc "Test" en ayant au préalable modifié le nom du fichier à fermer. Dans mon test, il s'appelle "Test.doc" :

Code :

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
67
68
69
 
Public Declare Function GetWindowText _
               Lib "user32" _
               Alias "GetWindowTextA" ( _
               ByVal hWnd As Long, _
               ByVal lpString As String, _
               ByVal cch As Long) As Long
 
Public Declare Function EnumWindows _
               Lib "user32" ( _
               ByVal lpEnumFunc As Long, _
               ByVal lParam As Long) As Long
 
Private Declare Function SendMessage _
                Lib "user32" _
                Alias "SendMessageA" ( _
                ByVal hWnd As Long, _
                ByVal wMsg As Long, _
                ByVal wParam As Long, _
                ByRef lParam As Any) As Long
 
Dim Fichier As String
Dim Fenetre As Long
 
Public Function Programme(ByVal hWnd As Long, _
                        ByVal Param As Long) As Long
 
    Dim Tampon As String
    Dim Retour As Long
 
    Tampon = Space(255)
    Retour = GetWindowText(hWnd, Tampon, 255)
 
    If Left(Tampon, 1) <> Chr(0) Then
 
        If InStr(Tampon, Fichier) <> 0 Then
 
            Programme = 0
            Fenetre = hWnd
            Exit Function
 
        End If
 
    End If
 
    Programme = 1
 
End Function
 
Sub Test()
 
    Dim Retour As Long
    Dim hWnd As Long
 
    Fichier = "Test.doc"
 
    Retour = EnumWindows(AddressOf Programme, 0&)
 
    If Retour = 0 Then
 
        SendMessage Fenetre, &H10, 0, ByVal 0&
 
    Else
 
        MsgBox Fichier & " n'est pas ouvert !"
 
    End If
 
End Sub

Hervé.

[kl1ft]

Salut Theze,

Merci d'avoir travaillé sur mon cas... je vais tester ton code.

Mon fichier doit impérativement s'appeler Test.doc ?

Dans mon cas de figure, les fichiers ont des noms et extensions qui changent tout le temps.

En tout cas un grand merci pour ton aide, c'est un début de piste

PS: j'essaye de comprendre... j'avoue que tu as utilisé des bout de code que je ne connais pas du tout...

kl1ft

[kl1ft]

Voici mon bout de code en question :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
 
 
'Macro qui déplace le fichier vers le dossier "Archivé"
        Dim TitleExt As String
        TitleExt = (Mid(LinkActuel, InStrRev(LinkActuel, "\"))) 'Variable qui stock le nom du fichier ==> \toto.pdf
 
        Dim SourceFolder, DestinationFolder, oFSO
        SourceFolder = LinkActuel 'lien du fichier ouvert c:\toto.pdf ou c:\titi.doc ... etc..
        DestinationFolder = CheminArchive & TitleExt 'Dossier de destination
        Set oFSO = CreateObject("Scripting.FileSystemObject")
        If SourceFolder = DestinationFolder Then
            MsgBox "Ce fichier est déjà archivé", vbInformation
        Else
        '### ici je souhaite fermer le fichier avant de le déplacer
            oFSO.MoveFile SourceFolder, DestinationFolder
            Worksheets("Gestion des documents").Cells(LigneMod, 9) = DestinationFolder
            'Worksheets("Gestion des documents").Cells(LigneMod, 1) = "Archivé"
        End If

si ça peut aider...

[Theze]

Bonsoir,

Voici le code un peut plus adapté à tes besoins (enfin, je pense !). Teste et reviens si ça ne convient pas :

Code :

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
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
 
Public Declare Function GetWindowText _
               Lib "user32" _
               Alias "GetWindowTextA" ( _
               ByVal hWnd As Long, _
               ByVal lpString As String, _
               ByVal cch As Long) As Long
 
Public Declare Function EnumWindows _
               Lib "user32" ( _
               ByVal lpEnumFunc As Long, _
               ByVal lParam As Long) As Long
 
Public Declare Function SendMessage _
               Lib "user32" _
               Alias "SendMessageA" ( _
               ByVal hWnd As Long, _
               ByVal wMsg As Long, _
               ByVal wParam As Long, _
               ByRef lParam As Any) As Long
 
Dim Fichier As String
Dim Fenetre As Long
 
Public Function Programme(ByVal hWnd As Long, _
                        ByVal Param As Long) As Long
 
    Dim Tampon As String
    Dim Retour As Long
 
    'crée un espace suffisant
    Tampon = Space(255)
 
    'retourne de titre de la fenêtre en cours
    Retour = GetWindowText(hWnd, Tampon, 255)
 
    'si le premier caractère n'est pas = à Null
    If Left(Tampon, 1) <> Chr(0) Then
 
        'si dans le titre de la fenêtre se trouve le texte cherché
        If InStr(Tampon, Fichier) <> 0 Then
 
            'récupère le handle de la fenêtre et fin de fonction
            Programme = 0
            Fenetre = hWnd
            Exit Function
 
        End If
 
    End If
 
    'passe à la fenêtre suivante
    Programme = 1
 
End Function
 
Sub Test()
 
    Dim SourceFolder, DestinationFolder, oFSO
    Dim TitleExt As String
    Dim hWnd As Long
 
    LinkActuel = "E:\Modules\Programmes\Fichier.xls"
 
    TitleExt = (Mid(LinkActuel, InStrRev(LinkActuel, "\") + 1)) 'Variable qui stock le nom du fichier ==> \toto.pdf
 
    SourceFolder = LinkActuel 'lien du fichier ouvert c:\toto.pdf ou c:\titi.doc ... etc..
 
    DestinationFolder = CheminArchive & TitleExt 'Dossier de destination
 
    Set oFSO = CreateObject("Scripting.FileSystemObject")
 
    If SourceFolder = DestinationFolder Then
 
        MsgBox "Ce fichier est déjà archivé", vbInformation
 
    Else
 
        '### ici je souhaite fermer le fichier avant de le déplacer
 
        'seul le nom du fichier à fermé est nécessaire,
        'le chemin complet n'étant pas utile
        Fichier = TitleExt
 
        'si le fichier a été trouvé, ferme le fichier avec
        'l'instance du programme associé sinon, affiche un message
        'car le fichier est déjà fermé
        If EnumWindows(AddressOf Programme, 0&) = 0 Then
 
            SendMessage Fenetre, &H10, 0, ByVal 0&
 
        Else
 
            MsgBox Fichier & " n'est pas ouvert !"
 
        End If
 
        oFSO.MoveFile SourceFolder, DestinationFolder
        Worksheets("Gestion des documents").Cells(LigneMod, 9) = DestinationFolder
        'Worksheets("Gestion des documents").Cells(LigneMod, 1) = "Archivé"
    End If
 
End Sub

Hervé.