[XL-2003] Message d'erreur : "Erreur d'exécution 70" sur création d'un Zip

[marc75017]

Bonsoir à Tous,

Voilà je débute tout juste sur VBA au travers d'Excel 2003, et je suis complètement bloquée sur un projet depuis 2 jours. Celui-ci consiste à automatiser le zip d'un fichier xls à la fin de son utilisation grâce à une macro.

J'ai trouvé une macro mais je n'arrive à y trouver l'erreur. Après de multiples tentatives, je désespère de ne pas trouver cette erreur qui, j'en suis sûre, ne doit pas être si énorme que ça alors si quelqu'un pouvait m'aider svp à résoudre cette énigme

Ci-dessous vous trouverez la macro que j'ai utilisé, malheureusement celle-ci s'arrête au niveau de : MyBinary = MyBinary & Chr(MyHex(i))
Next[/B]

et m'ouvre une fenêtre avec le message d'erreur suivant : "Erreur d'exécution 70 : Permission Refusée"

Voilà merci beaucoup si vous pouvez m'aider ou alors m'indiquer un autre code.

Bien cordialement,

Sabrina

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
 
Sub ZipFichier()
 
'
Dim oShell As Object, Fso As Object
Dim i As Long
Dim Fichier As String, MyBinary As String
Dim LeZip As Variant
Dim MyHex As Variant
 
    Fichier = "V:\001-Echange-Centrale\180.Direction_Marketing_et_Communication\07.Marketing_clients\01_Bases_Access\02_Historique\201011\_1110.zip"
    LeZip = "D:\Documents and Settings\JeanNoel.Floquet\Bureau\TEST"
 
    Set Fso = CreateObject("Scripting.FileSystemObject")
    MyHex = _
    Array(80, 75, 5, 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)
 
    For i = 0 To UBound(MyHex)
        MyBinary = MyBinary & Chr(MyHex(i))
    Next
 
    With Fso.CreateTextFile(LeZip, True)
        .Write MyBinary
        .Close
    End With
 
    Set oShell = CreateObject("Shell.Application")
    oShell.Namespace(LeZip).CopyHere (Fichier)
 
    Set oShell = Nothing
End Sub

[kiki29]

Salut, voir http://excel.developpez.com/sources/...#ZipperFichier

Code :

1
2
    Fichier = "C:\le classeur.xls"
    LeZip = "C:\Ma sauvegarde.zip"

[marc75017]

Bonjour,

Je vous remercie beaucoup pour votre aide. Néanmoins, j'ai réessayé en prenant exemple sur la macro que vous m'avez mise en pièce jointe et, cela ne fonctionne toujours pas (Vous la trouverez ci-dessous).

Alors, peut-être que je ne l'applique pas correctement probablement dû à mon manque d'expérience.

C'est pourquoi, je vais vous dire exactement ce que je fais sur cette macro une fois que je l'ai copié dans un nouveau module.

Tout d'abord, je fais un copier-coller de cette macro, ensuite je modifie essentiellement deux paramètres qui vont être le fichier à zipper donc mon xls, et le fichier de destination.

Première question, le fichier de destination doit-il obligatoirement être créée au préalable sur le bureau ? Si, c'est le cas, doit-on directement le mettre au format zip ou doit-on le laisser en mode dossier ?

Deuxième question, n'est-il pas nécessaire normalement d'indiquer l'emplacement du programme WinZip ?

Voilà, et lorsque je lance la macro, celle-ci ferme correctement le fichier en question et s'arrête en bloquant sur cette partie du code :
" MyBinary = MyBinary & Chr(MyHex(i))
Next"

Pouvez-vous me dire mon erreur ou mes erreurs dans l'application de cette macro ?

Je vous en remercie beaucoup par avance, le langage VBA m'intéresse beaucoup, j'ai vraiment envie d'apprendre à l'utiliser mais pour cela il faut que je puisse comprendre mes erreurs.


En vous souhaitant une belle journée,

Cordialement,

Sabrina

Ci-dessous, le code tel que je l'applique :

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
 Sub ZipRepertoire()
 
    '
 
    ActiveWorkbook.Close
    Const ForReading = 1, ForWriting = 2, ForAppending = 8
 
    Dim Source, Destination, MyHex, MyBinary, i
    Dim oShell, oApp, oFolder, oCTF, oFile
    Dim oFileSys
 
    'Spécifiez le répertoire
    Source = "P:\120.DirectionDesOperations\04.Marketing_Client\Reflexe_et_Fidelisation\C&S\_ASK\outils\Rank Entrepôts\2011\Rank_201109.xls"
    Destination = "D:\Documents and Settings\Sabrina.Jehanno\Bureau\TEST.zip"""
 
    MyHex = _
    Array(80, 75, 5, 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)
 
    For i = 0 To UBound(MyHex)
        MyBinary = MyBinary & Chr(MyHex(i))
    Next
 
    Set oShell = CreateObject("WScript.Shell")
    Set oFileSys = CreateObject("Scripting.FileSystemObject")
 
    'Création de la base du fichier zip.
    Set oCTF = oFileSys.CreateTextFile(Destination, True)
    oCTF.Write MyBinary
    oCTF.Close
    Set oCTF = Nothing
 
    Set oApp = CreateObject("Shell.Application")
 
    Set oFolder = oApp.Namespace(Source)
    If Not oFolder Is Nothing Then _
        oApp.Namespace(Destination).CopyHere oFolder.Items
 
    Set oFile = Nothing
    On Error Resume Next
 
    Do While (oFile Is Nothing)
        'Attention: provoque une erreur 70 si un des fichiers à zipper
        'est toujours ouvert.
        Set oFile = oFileSys.OpenTextFile(Destination, ForAppending, False)
 
        If Err.Number <> 0 Then
            Err.Clear
        End If
    Loop
 
    Set oFile = Nothing
    Set oFileSys = Nothing
End Sub

[kiki29]

re, le code fourni par Silkyroad fonctionne correctement , encore un drame du copier/coller

Dans le 1er post tu voulais zipper un fichier et maintenant c'est un dossier ?
http://excel.developpez.com/sources/...#ZipperDossier

Code :

1
2
    'Spécifiez le répertoire
    Source = "P:\120.DirectionDesOperations\04.Marketing_Client\Reflexe_et_Fidelisation\C&S\_ASK\outils\Rank Entrepôts\2011\Rank_201109.xls"

Rank_201109.xls est un fichier et non un dossier