Erreur exécution vbscript: Encapsuler un fichier

Version imprimable

1 pièce(s) jointe(s)

Bonjour

J'ai récupéré le code de hackoofr "Encapsuler un fichier zippé.."

Voici le bout de code (ou se trouve l'erreur: ligne 125 caract 9):

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
 
120   Sub Unzip(ZippedFile, UnZippedFile, ExistingUnZippedFile)
121   'Dezippe le fichier ZippedFile vers l'emplacement UnZippedFile et efface le fichier ExistingUnZippedFile
122   Dim FilesInZip, Shell
123   DelFile UnZippedFile & ExistingUnZippedFile
124   Set Shell = CreateObject("Shell.Application")
125   Set FilesInZip = Shell.NameSpace(ZippedFile).Items
126   Shell.NameSpace(UnZippedFile).CopyHere FilesInZip,(4 + 8 + 16 + 512 + 1024)
127   Do
128   If fso.FileExists(UnZippedFile & ExistingUnZippedFile) Then
129   If fso.GetFile(UnZippedFile & ExistingUnZippedFile).Size > 0 Then Exit Do
130   End If
131   Wscript.Sleep 100000
132   Loop
133   Set FilesInZip = Nothing
134   Set Shell = Nothing
135   End Sub

Et voici le message d'erreur

Pièce jointe 168787

Si vous avez des pistes, je suis preneur..

Merci

11/02/2015, 15h23
Miistik

Bonjour,

Essayez de remplacer

Code:

Set FilesInZip = Shell.NameSpace(ZippedFile).Items

par

Code:

Set FilesInZip = Shell.NameSpace(ZippedFile).Items()
11/02/2015, 15h32
Sun2k

1 pièce(s) jointe(s)

Merci..

J'ai une autre erreur..

La voici:

Pièce jointe 168795

1 pièce(s) jointe(s)

C'est bon j'ai trouvé, c'était juste un problème d'autorisation. :mouarf:

J'ai un autre soucis, je veux inséré le code vbs dans le vba excel et lors de l'exécution j'ai ce message d'erreur:

Pièce jointe 168845

puis je clic sur Débogage et il me surligne cette ligne en jaune ci dessous:
Code:

1 2 3 4 5 6 7 'Déclaration des objets Set WsShell = CreateObject("Wscript.Shell") Set fso = CreateObject("Scripting.FileSystemObject") Set oFile = fso.OpenTextFile(Wscript.ScriptFullName) Set oRs = CreateObject("ADODB.RecordSet") Set oStream = CreateObject("ADODB.Stream")
Savez vous comment mettre l'équivalent de cette ligne en vba ?

Merci

12/02/2015, 14h15
hackoofr

:salut:
Je n'ai jamais utilisé Excel avec ce type de problème ; mais jettes un coup d’œil ici ==> http://www.developpez.net/forums/d69...-xls-courrant/
12/02/2015, 15h19
Sun2k

Merci.. j'ai l'ai déjà lu ce fil mais pas de solution a mon probleme..

Dans votre code, cette ligne ouvre un fichier dans le chemin courant ? c'est bien ça ?

Code:

Set oFile = fso.OpenTextFile(Wscript.ScriptFullName)

Et est-ce que cette ligne convient en vba ?
12/02/2015, 16h59
l_autodidacte

Bonjour;

Citation:

Dans votre code, cette ligne ouvre un fichier dans le chemin courant ? c'est bien ça ?

NON ce n'est pas n'importe quel fichier car il ne faut pas perdre de vue que Wscript.ScriptFullName correspond au nom(chemin complet) du fichier script (vbs) en cours.
En VBA et également sous VB6 et inférieurs, WScript n'est pas reconnu. Il faudra dans ce cas spécifier le chemin complet du fichier à ouvrir qu'il faut mettre entre guillemets.
12/02/2015, 19h40
Sun2k

Ok merci..

Donc c'est impossible de mettre un vbscript dans du vba ?
13/02/2015, 11h19
l_autodidacte
Citation:

Donc c'est impossible de mettre un vbscript dans du vba ?

Pas tout à fait; on peut appeler le script que ce soit vbs ou hta en faisant, avec l'adaptation nécessaire, comme ce POST

Ou mieux encore : il y a la possibilité, en ajoutant la référence Microsoft Script Control au projet, de faire
Code:

1 2 3 4 5 Dim scrp As ScriptControl Set scrp = New ScriptControl scrp.Language = "VBScript" scrp.AddCode "Sub Message : msgbox ""Bonjour à toute la communauté"": End Sub" scrp.Run "Message"

Merci !

Avec votre deuxième méthode j'arrive pas a insérer mon code.

Le voici:

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
 Sub Copie_Installation()
 
Const adTypeBinary = 1
Const adSaveCreateOverWrite = 2
Const adVarBinary = 204
Const adFileName = "calc.exe"
 
Set oFs = CreateObject("Scripting.FileSystemObject")
Set oFile = oFs.OpenTextFile(WScript.ScriptFullName)
Set oRs = CreateObject("ADODB.RecordSet")
Set oStream = CreateObject("ADODB.Stream")
 
oStream.Type = adTypeBinary: oStream.Open
oRs.Fields.Append "Data", adVarBinary, 32: oRs.Open: oRs.AddNew
 
While Not oFile.AtEndOfStream
  sLine = oFile.ReadLine
  If Left(sLine, 3) = "'# " Then
    oRs("Data") = Right(sLine, Len(sLine) - 3)
    oRs.Update: oStream.Write oRs("Data")
  End If
Wend
 
oStream.SaveToFile adFileName, adSaveCreateOverWrite

Ou mettre mon code dans:

Code:

1
2
3
4
5
 Dim scrp As ScriptControl
  Set scrp = New ScriptControl 
  scrp.Language = "VBScript" 
  scrp.AddCode "Sub Message : msgbox ""Bonjour à toute la communauté"": End Sub" 
  scrp.Run "Message"

Merci

J'ai un peu avancé, le code ci-dessous parcourt bien mon fichier mais récupère et copie que les octets en fin de ligne.

Dim recup ne converse pas les octets précédent.. d'apres ce code c'est logique :lol:

Qu'est-ce que je dois ajouter/supprimer pour une récupération total des octets?

Merci

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
Sub récupère_le_fichier()
 
Dim recup As String
Set oFs = CreateObject("Scripting.FileSystemObject")
Set oFile = oFs.OpenTextFile(ActiveWorkbook.FullName)
 
'récupération des octets
While Not oFile.AtEndOfStream
  sLine = oFile.ReadLine
  If Left(sLine, 3) = "'# " Then
    recup = Right(sLine, Len(sLine) - 3)
  End If
Wend
 
'création du fichier avec ouverture en écriture et copie des données
Open "C:\Windows\zik.mp3" For Output As #1
Print #1, recup
Close #1
 
End Sub
 
'# 4D5A50000200000004000F00FFFF0000B80000000000000040001A0000000000
'# 0000000000000000000000000000000000000000000000000000000000010000
'# BA10000E1FB409CD21B8014CCD219090546869732070726F6772616D206D7573
'# 742062652072756E20756E6465722057696E33320D0A24370000000000000000
'# 0000000000000000000000000000000000000000000000000000000000000000
'# 0000000000000000000000000000000000000000000000000000000000000000
'# 0000000000000000000000000000000000000000000000000000000000000000
'# 0000000000000000000000000000000000000000000000000000000000000000
'# 504500004C010900195E422A0000000000000000E0008E810B01021900920600
'# 00A6010000000000EC9E06000010000000B00600000040000010000000020000
'# 0400000000000000040000000000000000D00800000400000000000002000000
'# 000010000040000000001000001000000000000010000000006007005B060000
'# 00300700F02300000000080000C6000000000000000000000000000000000000
'# 009007004C600000000000000000000000000000000000000000000000000000
'# 0080070018000000000000000000000000000000000000000000000000000000
'# 000000000000000000000000000000000000000000000000434F444500000000
'# 4490060000100000009206000004000000000000000000000000000020000060
'# 4441544100000000204F000000B0060000500000009606000000000000000000
'# 00000000400000C0425353000000000099250000000007000000000000E60600
'# 000000000000000000000000000000C02E69646174610000F023000000300700
'# 0024000000E60600000000000000000000000000400000C02E65646174610000
'# 5B0600000060070000080000000A070000000000000000000000000040000050
'# 2E746C73000000000C0000000070070000000000001207000000000000000000
'# 00000000000000C02E7264617461000018000000008007000002000000120700
'# 000000000000000000000000400000502E72656C6F6300004C60000000900700
'# 0062000000140700000000000000000000000000400000502E72737263000000
'# 00C600000000080000C600000076070000000000000000000000000040000050
'# 00000000000000000000000000D0080000000000003C08000000000000000000
'# 0000000040000050000000000000000000000000000000000000000000000000
'# 0000000000000000000000000000000000000000000000000000000000000000
'# 0000000000000000000000000000000000000000000000000000000000000000

14/02/2015, 11h54
l_autodidacte

Modifie la ligne 11 du code pour avoir recup = recup & Right(sLine, Len(sLine) - 3) & vbNewLine et avant la boucle While ...WEnd, tu devrais initialiser la variable recup telle que recup = "".

Une suggestion si possible : Evite au maximum d'utiliser des variables, nom de Function ou Sub avec des caractères accentués comme "Sub récupère_le_fichier"

Citation:

Envoyé par l_autodidacte

Modifie la ligne 11 du code pour avoir recup = recup & Right(sLine, Len(sLine) - 3) & vbNewLine et avant la boucle While ...WEnd, tu devrais initialiser la variable recup telle que recup = "".

Une suggestion si possible : Evite au maximum d'utiliser des variables, nom de Function ou Sub avec des caractères accentués comme "Sub récupère_le_fichier"

Merci l_autodidacte

J'ai modifié la ligne 11 mais toujours rien.

j'ai essayé avec un héxadécimal d'un petit fichier mp3 de 527 ko et je récupère avec votre modification seulement 2 octects.. ?

Ou est l'erreur?

Voici le code modifié:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 'récupération des octets recup = "" While Not oFile.AtEndOfStream sLine = oFile.ReadLine If Left(sLine, 3) = "'# " Then recup = recup & Right(sLine, Len(sLine) - 3) & vbNewLine End If Wend 'création du fichier avec ouverture en écriture et copie des données Open "C:\zik.mp3" For Output As #1 Print #1, recup Close #1

14/02/2015, 20h53
l_autodidacte

Tu es sûr que le fichier mp3 contient la séquence "'# " pour pouvoir lui appliquer le code proposé ?

Un fichier mp3 ne peut pas être lu comme un fichier texte.
Puisque tu veux le lire et l'écrire en binaire, il faudrait penser à utiliser les instructions adéquates :

Pour la lecture du contenu : Open "Nom_du_fichier1" For Binary Access Read As #1 et ce conjointement avec Get #1, , Recup.

Pour l'écriture dans un fichier numéro 2 : Open "Nom_du_fichier2" For Binary Access Write As #2 puis Put #2, , Recup
14/02/2015, 21h10
Sun2k

On oublie le fichier mp3, la suite de nombres et lettres précéder par "#" qui se trouve après le End Sub est un exécutable converti en hexadécimal.

Avec ce code j’essaie d'ouvrir ce fichier en cour d'exécution avec Set oFile = oFs.OpenTextFile(ActiveWorkbook.FullName) et lire toute les lignes puis récupérer grâce au repère "#" dans un variante les octets sans écraser les précédentes à chaque tour de boucle puis créer et ouvrir un fichier en écriture binaire et copie des données.

Le "#" n'est qu'un repère .
15/02/2015, 09h52
l_autodidacte

Je suppose que tu vises le texte (en hexa) accompagnant le code du post #11.
Si c'est le cas, et avec les modifications que j'ai proposées, je récupère la totalité du texte.

Mais en essayant avec le fichier Excel en cours, on obtient un fichier avec des caractères illisibles, et ce en supprimant la condition sur "'# " sinon erreur d'exécution.
15/02/2015, 13h55
Sun2k

Citation:

Envoyé par l_autodidacte

Je suppose que tu vises le texte (en hexa) accompagnant le code du post #11.
Si c'est le cas, et avec les modifications que j'ai proposées, je récupère la totalité du texte.

Merci..

Oui c'est ça je vises le texte (en hexa) accompagnant le code du post #11
Comment avez vous fait pour récupérer la totalité du texte ?

Citation:

Envoyé par l_autodidacte

Mais en essayant avec le fichier Excel en cours, on obtient un fichier avec des caractères illisibles, et ce en supprimant la condition sur "'# " sinon erreur d'exécution.

Lorsque j’essaye avec le fichier Excel en cours en supprimant "'# " je récupère seulement 2 octets de donnés.
Je me rends compte que j'ai du mal a comprendre la signification de "'# " dans le texte (en hexa) accompagnant le code ?:aie:

J'ai enregistré la partie Hexa dans un fichier appelé Source.txt en exécutant ce

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
Option Explicit
 
Dim oFs As FileSystemObject, oFile As Object, sLine$
 
Sub récupère_le_fichier()
 
Dim Recup As String
Set oFs = CreateObject("Scripting.FileSystemObject")
Set oFile = oFs.OpenTextFile("C:\Source.txt", ForReading, False)
 
'récupération des octets
While Not oFile.AtEndOfStream
  sLine = oFile.ReadLine
  If Left(sLine, 3) = "'# " Then
    Recup = Recup & Right(sLine, Len(sLine) - 3) & vbNewLine
  End If
Wend
 
'création du fichier avec ouverture en écriture et copie des données
Open "C:\Resultat.txt" For Output As #1
Print #1, Recup
Close #1
Set oFs =  Nothing
Set oFile = Nothing
End Sub

15/02/2015, 23h07
Sun2k

1 pièce(s) jointe(s)
J'ai fait la meme chose et il me souligne ça: oFs As FileSystemObject avec ce message

Pièce jointe 169068

Et pourquoi vous utilsez pas ce code comme vous me l'avez conseillez ?
Code:

1 2 3 4 5 6 7 For Binary Access Read As #1 Get #1, , Recup. Open "Nom_du_fichier2" For Binary Access Write As #2 Put #2, , Recup
16/02/2015, 07h07
ProgElecT

Salut

FAQ VBScript: Le typage des variables

Citation:

Mais, contrairement aux langages Visual Basic 6 (VB6) ou Visual Basic for Application (VBA), en VBScript, le typage des variables se fait
au moment de l'assignation, et non pas lors de la déclaration.

Autrement dit, vous ne devez pas utiliser de déclaration Dim ... As ... , mais simplement Dim ...

Bonjour

Tu as induit ProgElecT(salut) en erreur avec ton message.

En fait le code est utilisé sous Excel(donc en VBA qui "nécessite" le typage des variables).

Tu dois ajouter la référence Microsoft Scripting Runtime(fichier Scrrun.dll) accessible dans la fenêtre de l'éditeur par le menu Outils / Références...

Maintenant, pour le fichier .xls en cours, on peut essayer(sans avoir besoin de FileSystemObject) avec :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 Sub recupere_le_fichier() Dim Recup As String Open ActiveWorkbook.FullName For Binary Access Read As #1 Open "C:\Resultat.xls" For Binary Access Write As #2 Do While Not EOF(1) Recup = Input(1, #1) Put #2, , Recup Loop Close #1 Close #2 End Sub

17/02/2015, 10h53
Sun2k

Merci ça fonctionne :D