Lancer un programme externe avec des paramètres (Shell)

totor2027

XLDnaute Nouveau
Bonjour,

Afin de décoder des images stockées dans des fichiers textes (en base64), j'utilise un décodeur externe que je lance par VBA.

Voici le principe :
j'ouvre le CMD -> je me place dans le répertoire contenant l'EXE.
j'écris dans le CMD la commande du programme avec les paramètres.
je ferme le CMD

Voici la macro fonctionnelle :
PHP:
Sub Exe(NomSource As String, NomCible As String)
Shell "CMD /K " & """" & "cd " & ActiveWorkbook.Path & """"  ' OK
Application.Wait Now + TimeValue("00:00:01") '1 secondes
    Dim wsh As WshShell
    Set wsh = New WshShell
    wsh.AppActivate "cmd.exe"
    wsh.SendKeys "b64dec.exe " & NomSource & " " & NomCible & vbCrLf
Shell "taskkill /f /im CMD.exe", vbHide

'Shell "CMD /K " & """" & ActiveWorkbook.Path & "\b64dec.exe" & """"   ' OK lance le programme
'Shell "CMD /K " & """" & ActiveWorkbook.Path & "\b64dec.exe " & NomSource & " " & NomCible & """"  ' KO
'Shell "CMD /K " & """" & ActiveWorkbook.Path & "\b64dec.exe "  & """" & NomSource & " " & NomCible ' KO
End Sub

Alors ma question est comment simplifier le tout (car je ne trouve pas ça propre et oblige d'activer la référence externe "Windows Script Host" ), en fin de macro il y a quelques tests infructueux parmi beaucoup d'autres.
Je pence à des problèmes d'espaces mais ....

Si quelqu'un à une idée je suis preneur.

Cordialement.
 

Staple1600

XLDnaute Barbatruc
Re : Lancer un programme externe avec des paramètres (Shell)

Bonjour à tous


Pour le fun (et comme cela trainait au fin fond de mes archives) et pour ne pas passer par cmd.exe, on peut utiliser l'objet MSXML2
Pour tester copier un jpg sur C: et renommer le test.jpg puis lancer la macro encode
(par curiosité et pour voir le résultat, ouvrer B64picture.txt dans le le bloc-notes)
Puis lancer la macro decode pour transformer B64picture en test.jpg

totor2027
Il te reste à adapter pour boucler sur le répertoire contenant les fichiers texte encodés en B64 en utilisant le code utilisé dans la macro decode.

Fais nous savoir si cela fonctionne.

(J'ai testé sur mon PC, et cela fonctionne)
VB:
'adapté d'un script VBS de rodnower
Sub encode()
' This script reads jpg picture named test.jpg, converts it to base64
' code using encoding abilities of MSXml2.DOMDocument object and saves
' the resulting data to B64picture.txt file

Const fsDoOverwrite = True      ' Overwrite file with base64 code
Const fsAsASCII = False         ' Create base64 code file as ASCII file
Const adTypeBinary = 1          ' Binary file is encoded

'Variables
Dim objFSO, objFileOut, objXML, objDocElem, objStream
' Open data stream from picture
Set objStream = CreateObject("ADODB.Stream")
With objStream
    .Type = adTypeBinary
    .Open
    .LoadFromFile ("C:\test.jpg") ' à adapter
End With
' Create XML Document object and root node
' that will contain the data
Set objXML = CreateObject("MSXml2.DOMDocument")
Set objDocElem = objXML.createElement("Base64Data")
With objDocElem
.DataType = "bin.base64"
.nodeTypedValue = objStream.Read()
End With
' Open data stream to base64 code file
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFileOut = objFSO.CreateTextFile("c:\B64picture.txt", fsDoOverwrite, fsAsASCII)
' Get base64 value and write to file
objFileOut.Write objDocElem.Text
objFileOut.Close
' Clean all
Set objFSO = Nothing: Set objFileOut = Nothing: Set objXML = Nothing
Set objDocElem = Nothing: Set objStream = Nothing
End Sub
VB:
Sub decode()
' This script reads base64 encoded picture from file named B64picture.txt,
' converts it in to back to binary reprisentation using encoding abilities
' of MSXml2.DOMDocument object and saves data to test.jpg file

Const foForReading = 1          ' Open base 64 code file for reading
Const foAsASCII = 0             ' Open base 64 code file as ASCII file
Const adSaveCreateOverWrite = 2 ' Mode for ADODB.Stream
Const adTypeBinary = 1          ' Binary file is encoded

Dim objFSO, objFileIn, objStreamIn, objXML, objDocElem, objStream
' Open data stream from base64 code file
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFileIn = objFSO.GetFile("c:\B64picture.txt")
Set objStreamIn = objFileIn.OpenAsTextStream(foForReading, foAsASCII)
' Create XML Document object and root node
' that will contain the data
Set objXML = CreateObject("MSXml2.DOMDocument")
Set objDocElem = objXML.createElement("Base64Data")
With objDocElem
.DataType = "bin.base64"
.Text = objStreamIn.ReadAll()
End With
Set objStream = CreateObject("ADODB.Stream")
With objStream
    .Type = adTypeBinary
    .Open
End With
With objStream
    .Write objDocElem.nodeTypedValue
    .SaveToFile "c:\test.jpg", adSaveCreateOverWrite
End With
Set objFSO = Nothing: Set objFileIn = Nothing: Set objStreamIn = Nothing
Set objXML = Nothing: Set objDocElem = Nothing: Set objStream = Nothing
End Sub
 

totor2027

XLDnaute Nouveau
Re : Lancer un programme externe avec des paramètres (Shell)

totor2027
Il te reste à adapter pour boucler sur le répertoire contenant les fichiers texte encodés en B64 en utilisant le code utilisé dans la macro decode.

Fais nous savoir si cela fonctionne.

Je viens de mettre la boucle et de tester le code qui fonctionne parfaitement, c'est beaucoup plus propre que de passer par un CMD.

Merci beaucoup.

Même si mon problème est résolu (juste par curiosité intellectuelle) comment passe t-on des paramètres à un exécutable en VBA.

Voici le code de la macro modifié

Code:
Private Sub DecodeBase64()
' This script reads base64 encoded picture from file named B64picture.txt,
' converts it in to back to binary reprisentation using encoding abilities
' of MSXml2.DOMDocument object and saves data to test.jpg file

Const foForReading = 1          ' Open base 64 code file for reading
Const foAsASCII = 0             ' Open base 64 code file as ASCII file
Const adSaveCreateOverWrite = 2 ' Mode for ADODB.Stream
Const adTypeBinary = 1          ' Binary file is encoded

Dim objFSO, objFileIn, objStreamIn, objXML, objDocElem, objStream
' Open data stream from base64 code file
Set objFSO = CreateObject("Scripting.FileSystemObject")

Sheets("Feuil2").Select
    NB_Ligne = Range("A1000").End(xlUp).Row
   
Dim r As Integer
Dim NomSource As String
Dim NomCible As String
'
For r = 1 To NB_Ligne
    NomSource = CheminXml & Cells(r, 20).Value & ".txt"
    NomCible = CheminXml & Cells(r, 20).Value & ".jpg"

    Set objFileIn = objFSO.GetFile(NomSource)
    
    Set objStreamIn = objFileIn.OpenAsTextStream(foForReading, foAsASCII)
    ' Create XML Document object and root node
    ' that will contain the data
    Set objXML = CreateObject("MSXml2.DOMDocument")
    Set objDocElem = objXML.createElement("Base64Data")
    With objDocElem
    .DataType = "bin.base64"
    .Text = objStreamIn.ReadAll()
    End With
    Set objStream = CreateObject("ADODB.Stream")
    With objStream
        .Type = adTypeBinary
        .Open
    End With
    With objStream
        .Write objDocElem.nodeTypedValue
        .SaveToFile NomCible, adSaveCreateOverWrite
    End With

Next
    Set objFSO = Nothing: Set objFileIn = Nothing: Set objStreamIn = Nothing
    Set objXML = Nothing: Set objDocElem = Nothing: Set objStream = Nothing
End Sub
 

Staple1600

XLDnaute Barbatruc
Re : Lancer un programme externe avec des paramètres (Shell)

Bonsoir

totor2007
Merci d'avoir pris le temps de poster ton code final.

Pour ta dernière question, regardes dans les archives de forum, il me semble avoir lu et/ou participé à fil de discussion traitant du passage de paramètres à l'invite MSDOS.
 

Statistiques des forums

Discussions
312 613
Messages
2 090 234
Membres
104 463
dernier inscrit
lbo