[VBA Outlook] taille des pièces jointes

[greg778]

Bonjour,

Je sais qu'il est possible de récupérer la taille d'un mail...
Mais est-il possible de récupérer la taille de chaque pièce jointe ?

Je fais en fait une vérif à l'envoie d'un mail... s'il y a une pièce jointe, la routine affiche le nom du (des) pièce(s) jointe(s) dans le bas du mail... je voudrais y ajouter la taille de chaque pièce jointe pour avoir un truc du genre...

-----------------------------------------------------------------------
Pièces jointes :
"Rapport tarifaire du lot n° 12345.HTML" (125 Ko)
"Rapport de production du lot n° 12345 - Contenants.HTML" (365 Ko)

en noir ce que j'ai déjà et en bleu ce que je voudrais y ajouter...

dans mon code je fais une boucle sur les pièces jointes pour les ajouter à ma liste, je suppose que c'est dans cette boucle que je devrais récupérer la taille de chaque pièce jointe :

  For Each PJ In Item.Attachments
   'If Not (PJ = "SignatureVprint.gif") And Not (PJ = "ecblank.gif") And Not (PJ = "Blank Bkgrd.gif") Then
   'MsgBox (PJ & "::" & InStr(1, ImagesIgnorees, PJ, 1))
   If (InStr(1, ImagesIgnorees, PJ, 1) = 0) And Not (Left(PJ, 5) = "ATT00") Then
    taillePJ = 0 'Round(PJ.Size * 1.33 / 1000000, 2)
    ListePJ = ListePJ & """" & PJ.FileName & """" & "  (" & taillePJ & "Mo)<br>"
    cptPJ = cptPJ + 1
   End If
  Next PJ

PJ.size ne fonctionne pas...

[Oliv-]

Bonjour,
Effectivement Attachment n'a pas de propriété size.

Attention la règle des + 33 % ne vaut que pour la taille du mail "envoyé" provenant du codage internet.
'Round(PJ.Size * 1.33 / 1000000, 2)

Il faut passer par CDO ou REDEMPTION

Avec CDO il faut ajoute rune référence à CDO 1.21

Sub babaCDO()
'--------------------------------------------------------------------------
' Procedure : babaCDO
' Author    : Oliv'
' Date      : 25/04/2008
' Purpose   :
'--------------------------------------------------------------------------
Dim INSP, Item, StrEntryID
' ici on utilise outlook
Set INSP = ActiveInspector 'désigne la fenêtre de l'élement actif
Set Item = INSP.CurrentItem ' désigne la mail actif (ouvert)
StrEntryID = Item.EntryID 'désigne le mail 
' on crée une MAPI session = CDO
 
Dim objSession As MAPI.Session
Set objSession = New MAPI.Session
Dim CDOMsg As MAPI.Message, PJ
 
' On se log utilisant une MAPI session existante (celle de outlook)
objSession.Logon "", "", False, False, 0
 
' on retrouve le message avec son entryid
Set CDOMsg = objSession.GetMessage(StrEntryID)
 
For Each PJ In CDOMsg.Attachments
 
' on affiche la taille des PJ
MsgBox PJ.Fields.Item(CdoPR_ATTACH_SIZE)
Next
 
' Logoff DE MAPI Session
objSession.Logoff
End Sub
 
 

[Dolphy35]

Salut,

pour utiliser la méthode Size, il faut que ta pièce jointe est été traité, il te faut donc enregistrer ton message avant

tu peux te baser sur le code d'Oliv-
Comment afficher un message lorsque le mail dépasse un capacité définie ?


Dolphy

[greg778]

pas trop compris ta Sub babaCDO...
je chercherai un peu plus tard...

Dolphy, merci pour le lien, j'avais en effet déjà consulter l'aide et vu ce post ; mais ça donne la taille du mail, et pas de la (des) pièce(s) jointe(s)...

bien sûr on pourrait faire ceci : prendre la taille du mail au départ et comparer avec la taille renvoyée avec les pièces jointes, mais ça serait un peu le bordel...

Comme pour mon cas c'est juste une info que j'aurai rajoutée à titre indicatif, je pensais pouvoir trouver une ptite fonction à intégrer dans ma boucle...

merci pour ces infos...
Greg

[Oliv-]

En fait tu peux accéder à tes mail avec OUTLOOK ou avec d'autres programmes comme CDO.

regarde de nouveau le code j'ai ajouté des commentaires.

[greg778]

toujours pas trop pigé cette histoire de "programme CDO"

c'est bien dans le VbaProject > ThisOutlookSession que tu mets ta sub babaCDO ?!?

je regarderai lundi... plus de temps...

pour info, voici le code complet que je fais lors de l'envoie d'un mail :

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim ListePJ As String
Dim ImagesIgnorees As String
Dim Debut, debutRE, debutTR, cptPJ, taillePJ As Integer
ImagesIgnorees = "SignatureVprint.gif ecblank.gif Blank Bkgrd.gif EcoAttitude.gif EcoAttitudeTexte.gif Image001.gif Image002.gif"
 'MsgBox ("Item :" & Chr(13) & Chr(10) & Item)
 'MsgBox ("Item.BodyFormat :" & Chr(13) & Chr(10) & Item.BodyFormat)  '1 pour format TEXTE BRUT et 2 pour format HTML
 'MsgBox ("HTMLBody :" & Chr(13) & Chr(10) & Item.HTMLBody)
 'MsgBox ("Body :" & Chr(13) & Chr(10) & Item.Body)
 'MsgBox ("Envoi d'un mail")
 'MsgBox (oMessage.HTMLBody)
 'babaCDO j'ai tenté de mettre ça là mais ça ne doit pas être sa place !!
 If (Item.BodyFormat = 2) And Item.Attachments.Count > 0 Then 'Not (Item.HTMLBody = vbNullString) And Item.Attachments.Count > 0 Then
  cptPJ = 0
  ListePJ = ""
  For Each PJ In Item.Attachments
   If (InStr(1, ImagesIgnorees, PJ, 1) = 0) And Not (Left(PJ, 5) = "ATT00") Then
    'taillePJ = Round(PJ.Size * 1.33 / 1000000, 2)
    ListePJ = ListePJ & """" & PJ.FileName & """<br>" '& """" & "  (" & taillePJ & "Mo)<br>"
    cptPJ = cptPJ + 1
   End If
  Next PJ
  If Not (ListePJ = "") Then
   If cptPJ = 1 Then
    ListePJ = "<FONT face=Arial color=#606060 size=1><u>Pièce jointe</u> : <br>" & ListePJ & "</font>"
   Else
    ListePJ = "<FONT face=Arial color=#606060 size=1><u>Pièces jointes</u> : <br>" & ListePJ & "</font>"
   End If
   debutRE = InStr(1, Item.HTMLBody, "<BLOCKQUOTE ", 1)
   debutTR = InStr(1, Item.HTMLBody, "<DIV class=OutlookMessageHeader", 1)
   If (debutRE < debutTR) And Not (debutRE = 0) Then
    Debut = debutRE - 1
   Else
    Debut = debutTR
   End If
   If Debut = 0 Then
    Item.HTMLBody = Item.HTMLBody & "<hr>" & ListePJ
   Else
    Item.HTMLBody = Mid(Item.HTMLBody, 1, Debut - 1) & "<br><br><hr>" & ListePJ & "<br><br>" & Mid(Item.HTMLBody, Debut, Len(Item.HTMLBody))
   End If
  End If
 ElseIf (Item.BodyFormat = 1) And Item.Attachments.Count > 0 Then 'Not (Item.Body = vbNullString) And Item.Attachments.Count > 0 Then
  cptPJ = 0
  ListePJ = ""
  For Each PJ In Item.Attachments
   If (InStr(1, ImagesIgnorees, PJ, 1) = 0) And Not (Left(PJ, 5) = "ATT00") Then
    ListePJ = ListePJ & """" & PJ.FileName & """" & Chr(10)
    cptPJ = cptPJ + 1
   End If
  Next PJ
  If Not (ListePJ = "") Then
   If cptPJ = 1 Then
    ListePJ = "Pièce jointe : " & Chr(10) & ListePJ
   Else
    ListePJ = "Pièces jointes : " & Chr(10) & ListePJ
   End If
   Debut = InStr(1, Item.Body, "-----Message d'origine-----", 1)
   If Debut = 0 Then
    Item.Body = Item.Body & Chr(10) & Chr(10) & "-----------------------------------------------------------------------" & Chr(10) & ListePJ
   Else
    Item.Body = Mid(Item.Body, 1, Debut - 1) & Chr(10) & Chr(10) & "-----------------------------------------------------------------------" & Chr(10) & ListePJ & Chr(10) & Chr(10) & Mid(Item.Body, Debut, Len(Item.Body))
   End If
  End If
 End If
End Sub

[Dolphy35]

Salut,

Envoyé par Oliv-

Effectivement Attachment n'a pas de propriété size.

cette propriété a été intégré dans la version 2007

cf code fonctionnement sous 2007 seulement :

Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
'---------------------------------------------------------------------------------------
' Procédure : Application_ItemSend
' Auteur    : Dolphy35 - http://dolphy35.developpez.com/
' Date      : 25/04/2008
' Détail    : Avant l'envoi d'un affichage d'un msg avec le nom et la taille des pièces jointes
'---------------------------------------------------------------------------------------
'
'Déclaration de l'objet
    Dim objPJ As Attachment
    
    'Test si le formulaire à envoyé correspond à un Mail
    If Not Item.Class = olMail Then Exit Sub
 
    'Boucle pour afficher un message avec le nom et la taille convertie pour chaque Pièces jointes
    For Each objPJ In Item.Attachments
        MsgBox objPJ.FileName & vbCr & MEF_Octet(objPJ.Size)
    Next
    
End Sub

petite fonction en prime pour convertir des octets jusqu'au giga

Public Function MEF_Octet(lgValeur As Long) As String
'---------------------------------------------------------------------------------------
' Procédure : MEF_Octet
' Auteur    : Dolphy35 - http://dolphy35.developpez.com/
' Date      : 25/04/2008
' Détail    : Fonction permettant un affichage en octet, kilo, mega ou giga selon valeur passée en paramètre
'---------------------------------------------------------------------------------------
'
'test si la valeur correspond à l'octet
    If (lgValeur / 1024 > 1) Then
        lgValeur = lgValeur / 1024
        'test si la valeur correspond au kilo
        If (lgValeur / 1024 > 1) Then
            lgValeur = lgValeur / 1024
            'test si la valeur correspond au méga
            If (lgValeur / 1024 > 1) Then
                lgValeur = lgValeur / 1024
                'test si la valeur correspond au giga
                If (lgValeur / 1024 > 1) Then
                    lgValeur = lgValeur / 1024
                Else
                    MEF_Octet = CStr(lgValeur) & " Go"    'charge la valeur convertie en string dans la variable
                End If
            Else
                MEF_Octet = CStr(lgValeur) & " Mo"  'charge la valeur convertie en string dans la variable
            End If
        Else
            MEF_Octet = CStr(lgValeur) & " Ko"    'charge la valeur convertie en string dans la variable
        End If
    Else
        MEF_Octet = CStr(lgValeur) & " Oct"    'charge la valeur convertie en string dans la variable
    End If
 
End Function

Dolphy

[Oliv-]

Bonjour,
Merci pour l'info DOLPHY35 et la fonction. Si je peux me permettre en modifiant
MEF_Octet(lgValeur As Double) et MEF_Octet=CStr(Round(lgValeur, 2))

tu obtiens un résultat genre 2.98 Mo

[Dolphy35]

Salut Oliv-,

Envoyé par Oliv-

Bonjour,
Merci pour l'info DOLPHY35 et la fonction. Si je peux me permettre en modifiant
MEF_Octet(lgValeur As Double) et MEF_Octet=CStr(Round(lgValeur, 2))

tu obtiens un résultat genre 2.98 Mo

c'est vrai que cela donne une valeur plus précise je m'étais contenté d'afficher la valeur qu'affiche Outlook.




Dolphy

[greg778]

Hello,

merci pour vos réponses, et la ptite fonction MEF_Octet de Dolphy

je peux donc oublié ça pour Outlook 2003...

merci,
à+
Greg

[Oliv-]

Bonsoir
C'est juste un peu plus compliqué pour les versions avent 2007 mais pas impossible.