Problème MACRO Zip sur exel 2003 : erreur introuvable Besoin d'aide

Sabrina75017

XLDnaute Nouveau
Bonjour à 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 pour résoudre cette énigme :)

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 :
Code:
" MyBinary = MyBinary & Chr(MyHex(i))
Next"

Pouvez-vous me dire mon erreur ou mes erreurs dans l'application de cette macro ou alors avez-vous une macro plus simple d'utilisation?

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:
Sub ZipFichier()

ActiveWorkbook.Close

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

LeZip = "P:\120.DirectionDesOperations\04.Marketing_Client\Reflexe_et_Fidelisation\C&S\_ASK\outils\Rank Entrepôts\2011\Rank_201109.zip"
Fichier = "D:\Documents and Settings\Sabrina.Jehanno\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

Bien Cordialement,

Sabrina
 

Sabrina75017

XLDnaute Nouveau
Re : Problème MACRO Zip sur exel 2003 : erreur introuvable Besoin d'aide

Bonjour,

Excuse moi, je viens de m'apercevoir de votre réponse seulement à l'instant. Bien entendu, je vous remercie beaucoup pour votre aide.

D'ailleurs, la macro fonctionne très bien maintenant en appliquant le code comme ci-dessous :

Code:
Sub ZipFichier()


ActiveWorkbook.Close

Dim oShell As Object, Fso As Object
Dim Fichier As String, MyBinary As String
Dim LeZip As Variant
Dim MyHex As Variant

LeZip = "P:\120.DirectionDesOperations\04.Marketing_Client\Reflexe_et_Fidelisation\C&S\_ASK\outils\Rank Entrepôts\2011\Rank_201109.zip"
Fichier = "P:\120.DirectionDesOperations\04.Marketing_Client\Reflexe_et_Fidelisation\C&S\_ASK\outils\Rank Entrepôts\2011\Rank_201109.xls"

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

Sub test()
Dim Fich As String
Const chemin = "P:\120.DirectionDesOperations\04.Marketing_Client\Reflexe_et_Fidelisation\C&S\_ASK\outils\Rank Entrepôts\2011\zip\"
Fich = Dir(chemin & "*.xls")
Do While Fich <> ""
Workbooks.Open chemin & Fich
' là, tu mets ton code
Dim oShell As Object, Fso As Object
Dim Fichier As String, MyBinary As String
Dim LeZip As Variant
Dim MyHex As Variant

LeZip = "P:\120.DirectionDesOperations\04.Marketing_Client\Reflexe_et_Fidelisation\C&S\_ASK\outils\Rank Entrepôts\2011\Rank_201109.zip"
Fichier = "P:\120.DirectionDesOperations\04.Marketing_Client\Reflexe_et_Fidelisation\C&S\_ASK\outils\Rank Entrepôts\2011\Rank_201109.xls"

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

Workbooks(Fich).Close True 'ou true si tu enregistres
Fich = Dir
Loop
End Sub
 

Discussions similaires

Statistiques des forums

Discussions
312 097
Messages
2 085 261
Membres
102 844
dernier inscrit
atori2