Décompresser un fichier CAB sous Outlook 2000

Question

Bonjour a tous, 

Je reçois par mail sur mon lieu de travail des rapports d'engins au format Access 2007. Comme parfois il y a des retards, ça arrive que je reçoive plusieurs mail (une vingtaine) d'un coup. Enfin, tous mes fichiers mdb que je reçois sont compresser en Cabinet (*.cab).

Pour traité les rapports, j'ai besoin de sortir toutes les pièces jointes des mails (ça c'est fait et fonctionne correctement), mais maintenant j'ai besoin de les décompresser. Une fois tous les fichiers décompresser, un assemblage des fichiers sera à faire sous Access, mais pour ça, je maîtrise.

Donc mon seul souci est la décompression des *.cab.

Etant sous VBA, je n'ai pu ouvrir les solutions proposées en VB. Si quelqu'un pouvait me donner un bout de code, je serai preneur.

A tout hasard, j'ai essayé aussi avec Winzip en ligne de commande via un appel par Shell, mais ça n'a rien donné de correct.
J'ai ensuite crée un fichier .bat puis exécuté par Shell, mais pareil, rien de bon.

Merci d'avance

dede76600 · Answer

Petite mise à jour !

Merci d'avance pour les courageux qui répondront...

dede76600 · Answer

Pour info je vous mets mon morceau de code :

Sub Extraction_rapport()
    '====Déclaration
    Dim nomfichier
    Dim monMail, mesPiècesJointes As Object
    Dim destination As String 'destination des fichiers
    Dim monOutlook As New Outlook.Application
    Dim monEplorateur As Outlook.Explorer
    Dim maSelection As Outlook.Selection
    Dim i As Integer
    Dim jourdatemail, moisdatemai, annéedatemail, datemail As String
    
    Dim command
    
    '====Boîte de dialogue simple pour le chemin de sauvegarde
    destination = InputBox("Destination", "Sauvegarder les pièces", "C:	empo")

    On Error Resume Next
    
    '====Actions sur les objets sélectionnés
    Set monEplorateur = monOutlook.ActiveExplorer
    Set maSelection = monEplorateur.Selection
    
    '====Boucle sur les mails
    For Each monMail In maSelection
            Set mesPiècesJointes = monMail.Attachments
            If mesPiècesJointes.Count > 0 Then
                    '======Boucle sur les pièces jointes
                    For i = 1 To mesPiècesJointes.Count
                        If mesPiècesJointes(i).DisplayName "Base_Export.cab" Or mesPiècesJointes(i).DisplayName "Datalogs.cab" Then '====Verifie le nom du fichier
                            '====Récupération de la date du rapport dans l'objet du mail
                            jourdatemail = Left(Right(monMail.Subject, 9), 2)
                            moisdatemail = Mid(Right(monMail.Subject, 9), 4, 2)
                            annéedatemail = Mid(Right(monMail.Subject, 9), 7, 2)
                            datemail = jourdatemail & "-" & moisdatemail & "-" & annéedatemail & "_"
                            
                            '====Sauvegarder la pièce
                            nomfichier = datemail & mesPiècesJointes(i).DisplayName
                            'mesPiècesJointes(i).SaveAsFile destination & nomfichier
                            mesPiècesJointes(i).SaveAsFile "c:\Program Files\WinZip" & nomfichier
                            
                            '====Dézzipper

                            command = Shell("C:\Program Files\MacroCad\datalog\cmd.exe", 2)
                            SendKeys "cd C:\Program Files\WinZip", True
                            SendKeys "{ENTER}", False
                            SendKeys "winzip32.exe -e " & nomfichier & " " & destination, False
                            SendKeys "{ENTER}", False
                            SendKeys "exit" + "{ENTER}", False
                            
                            '====Renommer le dernier fichier en fonction de datemail
                            
                        End If
                    Next i
            End If
    Next
    
    Set monMail = Nothing
    Set mesPiècesJointes = Nothing
    Set monOutlook = Nothing
    Set monEplorateur = Nothing
    Set maSelection = Nothing
End Sub


Comme c'est un code en cour de travaux, il y de petites erreurs dans les adresses de fichier, mais l'idée est là.

dede76600 · Answer

Même pas un petit message avant le Week-end ?
Mon sujet n'intéresse t il donc personne ? Ou au contraire la solution est devant et personne n'ose me le dire tellement c'est évident.
S'il vous plait, si la méthode que j'utilise n'est pas la bonne, dites-le-moi !!!

dede76600 · Answer

A tout hasard, quelqu'un connait la fonction Expand.exe sous Wndows XP. Ce petit utilitaire sert à extraire les fichiers *.cab.
Mais comme c'est le meme type d'instruction que pour Winzip, je ne sais toujours pas comment l'exploiter.

Est ce que créer une fonction faisant référence au soft de décompression pourrait marcher ? Et comment celle-ci devrait etre écrite en VBA ?

dede76600 · Answer

Personne aurai idée pour moi ?

dede76600 · Answer

Personne sais comment exécuter un fichier *.bat depuis VBA ?

dede76600 · Answer

Re bonjour,

Je ne perds pas espoir.

Après avoir téléchargé une version allégée de VB (Visual Studio 2008 Express Edition), après trouver ce lien : http://www.vbfrance.com/codes/EXTRACTEUR-FICHIERS-CAB_1805.aspx

Je me suis aperçu que le code de cet Extracteur est exactement ce que je cherche, bien qu'il y ait quelques différences.
A savoir, pour ceux qu'ils veulent m'aider et qui télécharge l'Extracteur du lien :
_première différence, dans le Main.frm, dans le cade, il écrit dans un fichier *.bat la commande « extract ». Après quelques heures de recherche, je pense que cette fonction n'existe plus sous WinXP. Du coup, dans mon cas je l'ai remplacé par un « Expand »
_deuxième différence, quand on exécute ma macro, la fonction Shell ne réagit plus comme elle le faisait dans l'Extracteur. En effet, le fichier *.bat exécute le script correctement quand il est lancé depuis Windows, mais dès que celui-ci est sollicité depuis la macro, il ne se passe rien du tout?

Conclusion, maintenant que j'ai une solution, mon problème se trouve déporté sur la fonction Shell.
Si quelqu'un pouvait m?aider, en attendant, je vais fouiller dans les pages Shell du forum.

dede76600 · Answer

Re bonjour a tous !!! J'ai avancé depuis sur mon morceau de code, mais visiblement j'ai encore quelque difficulté. Voici mon code en état aujourd'hui : Public destination Sub Extraction_rapport() '====Déclaration Dim monMail, mesPiècesJointes As Object Dim monOutlook As New Outlook.Application Dim monEplorateur As Outlook.Explorer Dim maSelection As Outlook.Selection Dim i As Integer Dim jourdatemail As String, moisdatemai As String, annéedatemail As String, datemail As String '====Boîte de dialogue simple pour le chemin de sauvegarde destination = InputBox("Destination", "Sauvegarder les pièces", "C: empo") On Error Resume Next '====Actions sur les objets sélectionnés Set monEplorateur = monOutlook.ActiveExplorer Set maSelection = monEplorateur.Selection '====Boucle sur les mails For Each monMail In maSelection Set mesPiècesJointes = monMail.Attachments If mesPiècesJointes.Count > -1 Then '======Boucle sur les pièces jointes For i = 1 To mesPiècesJointes.Count '======Récupéré les bonnes pièces jointes If mesPiècesJointes(i).DisplayName "Base_Export.cab" Or mesPiècesJointes(i).DisplayName "Datalogs.cab" Then '====Récupération de la date du rapport dans l'objet du mail jourdatemail = Left(Right(monMail.Subject, 9), 2) moisdatemail = Mid(Right(monMail.Subject, 9), 4, 2) annéedatemail = Mid(Right(monMail.Subject, 9), 7, 2) datemail = jourdatemail & "-" & moisdatemail & "-" & annéedatemail & "_" '====Sauvegarde la pièce nomfichier = datemail & mesPiècesJointes(i).DisplayName mesPiècesJointes(i).SaveAsFile destination & nomfichier End If Next i End If Next Dézzip_mail Set monMail = Nothing Set mesPiècesJointes = Nothing Set monOutlook = Nothing Set monEplorateur = Nothing Set maSelection = Nothing End Sub Sub Dézzip_mail Dim fichier Dim rename Dim maPièce 'Emplacement et extention des fichiers adresse = destination extention = "cab" fichier = Dir(adresse & "*." & extention, vbNormal) Do While fichier <> "" If fichier <> "." And fichier <> ".." Then maPièce = fichier '====Créer le fichier *.bat qui dézippera Set fs = CreateObject("Scripting.FileSystemObject") Set a = fs.CreateTextFile(destination & "tempo.bat", True) a.writeline ("@Echo off") a.writeline ("expand -r " & "c: empo" & maPièce & " " & "c: empo") a.Close essai = Shell(destination & "tempo.bat", vbHide) '====Renome le fichier extrait du *.cab rename = Left(maPièce, Len(maPièce) - 4) maPièce = Right(rename, Len(rename) - 9) MsgBox maPièce 'C'est ici que ca plante, si j'enlève le msgbox ici(qui n'était la au départ que pour vérifier les variables), la boucle ne s'éxécute pas correctement If "Base_Export" = maPièce Then rename = rename & ".mdb" Name "c: empo\Base_Export.mdb" As "c: empo" & rename Else rename = rename & ".txt" Name "c: empo\Datalogs.txt" As "c: empo" & rename End If End If fichier = Dir Loop End Sub Donc comme précisé dans le code, dans la procédure Dézzip_mail, je bloque a cause d'une histoire de MsgBox. Je pense a un probleme de déclaration de variable... Si quelqu'un avait une idée. En même temps, depuis le début que j'ai écris ce poste, je dialogué seul, donc !!! Mais merci tout de meme a celui qui dérrogera à la règle !!!

PCPT · Answer

salut,
a.writeline ("expand -r " & "c:	empo" & maPièce & " " & "c:	empo")
a.writeline ("expand c:	empo" & maPièce & " -f:* c:	empo")

http://support.microsoft.com/kb/314958/fr

reste à voir si tu ne vas pas écraser la précédente extraction, en boucle
++
[hr]

Décompresser un fichier CAB sous Outlook 2000

9 réponses

Votre réponse

Discussions similaires