Décompresser un fichier CAB sous Outlook 2000

Signaler
Messages postés
10
Date d'inscription
samedi 12 février 2005
Statut
Membre
Dernière intervention
26 août 2009
-
Messages postés
13280
Date d'inscription
lundi 13 décembre 2004
Statut
Modérateur
Dernière intervention
3 février 2018
-
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

9 réponses

Messages postés
10
Date d'inscription
samedi 12 février 2005
Statut
Membre
Dernière intervention
26 août 2009

Petite mise à jour !

Merci d'avance pour les courageux qui répondront...
Messages postés
10
Date d'inscription
samedi 12 février 2005
Statut
Membre
Dernière intervention
26 août 2009

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:\tempo")

    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à.
Messages postés
10
Date d'inscription
samedi 12 février 2005
Statut
Membre
Dernière intervention
26 août 2009

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 !!!
Messages postés
10
Date d'inscription
samedi 12 février 2005
Statut
Membre
Dernière intervention
26 août 2009

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 ?
Messages postés
10
Date d'inscription
samedi 12 février 2005
Statut
Membre
Dernière intervention
26 août 2009

Personne aurai idée pour moi ?
Messages postés
10
Date d'inscription
samedi 12 février 2005
Statut
Membre
Dernière intervention
26 août 2009

Personne sais comment exécuter un fichier *.bat depuis VBA ?
Messages postés
10
Date d'inscription
samedi 12 février 2005
Statut
Membre
Dernière intervention
26 août 2009

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.
Messages postés
10
Date d'inscription
samedi 12 février 2005
Statut
Membre
Dernière intervention
26 août 2009

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:\tempo")

    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:\tempo" & maPièce & " " & "c:\tempo")
                    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:\tempo\Base_Export.mdb" As "c:\tempo" & rename
                    Else
                        rename = rename & ".txt"
                        Name "c:\tempo\Datalogs.txt" As "c:\tempo" & 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 !!!
Messages postés
13280
Date d'inscription
lundi 13 décembre 2004
Statut
Modérateur
Dernière intervention
3 février 2018
47
salut,
a.writeline ("expand -r " & "c:\tempo" & maPièce & " " & "c:\tempo")
a.writeline ("expand c:\tempo" & maPièce & " -f:* c:\tempo")

http://support.microsoft.com/kb/314958/fr

reste à voir si tu ne vas pas écraser la précédente extraction, en boucle
++
[hr]