Il faut ajouter une référence à "Microsoft CDO 1.21 LIBRARY" en
cochant la case dans outils références.
Il faut ajouter une référence à "Microsoft CDO 1.21 LIBRARY" en
cochant la case dans outils références.
Il faut ajouter une référence à "Microsoft CDO 1.21 LIBRARY" en
cochant la case dans outils références.
Bonjour -=lolol=-,
pî d'ailleurs pas la moindre CDO.dll sur mon pc !
est ce normal, j'ai outlook 2003 issu de ma CAL SBS2003 ?
Avez vous cette dll chez vous ?
merci pour votre aide
@+lolo
Bonjour -=lolol=-,
pî d'ailleurs pas la moindre CDO.dll sur mon pc !
est ce normal, j'ai outlook 2003 issu de ma CAL SBS2003 ?
Avez vous cette dll chez vous ?
merci pour votre aide
@+lolo
Bonjour -=lolol=-,
pî d'ailleurs pas la moindre CDO.dll sur mon pc !
est ce normal, j'ai outlook 2003 issu de ma CAL SBS2003 ?
Avez vous cette dll chez vous ?
merci pour votre aide
@+lolo
Bonjour -=lolol=-,
pî d'ailleurs pas la moindre CDO.dll sur mon pc !
est ce normal, j'ai outlook 2003 issu de ma CAL SBS2003 ?
Avez vous cette dll chez vous ?
merci pour votre aide
@+lolo
chez moi OFFICE 2003 SP2
C:Program FilesFichiers communsSystemMSMAPI1036cdo.dll
mais ca marche peut être avec
microsoft CDO for exchange 2000 library
Oliv'
Bonjour -=lolol=-,
pî d'ailleurs pas la moindre CDO.dll sur mon pc !
est ce normal, j'ai outlook 2003 issu de ma CAL SBS2003 ?
Avez vous cette dll chez vous ?
merci pour votre aide
@+lolo
chez moi OFFICE 2003 SP2
C:Program FilesFichiers communsSystemMSMAPI1036cdo.dll
mais ca marche peut être avec
microsoft CDO for exchange 2000 library
Oliv'
Bonjour -=lolol=-,
pî d'ailleurs pas la moindre CDO.dll sur mon pc !
est ce normal, j'ai outlook 2003 issu de ma CAL SBS2003 ?
Avez vous cette dll chez vous ?
merci pour votre aide
@+lolo
chez moi OFFICE 2003 SP2
C:Program FilesFichiers communsSystemMSMAPI1036cdo.dll
mais ca marche peut être avec
microsoft CDO for exchange 2000 library
Oliv'
au pire tu remplaces
typeatt = Attachtype(strEntryID, objAtt.index)
par typeatt =""
au pire tu remplaces
typeatt = Attachtype(strEntryID, objAtt.index)
par typeatt =""
au pire tu remplaces
typeatt = Attachtype(strEntryID, objAtt.index)
par typeatt =""
Bonjour Oliv',
Je te compte mon histoire suite ta réponseau pire tu remplaces
typeatt = Attachtype(strEntryID, objAtt.index)
par typeatt =""
je plante un peu plus loin, ici
resultat = objShell.Run(tacommande, 1, True)
Erreur d'éxécution '-2147024894 (80070002)':
La méthode 'Run' de l'objet 'IWshShell3' a échoué
Je note que :
7-zip (version 4.32) est installé et fonctionne
dans ta variable "tacommande" tu fais appel à 7za.exe
bien que dans le readme.txt je puisse lire
This distrubutive packet contains the following files:
...
7za.exe - 7-Zip standalone command line version
...
je n'ai pas ce fichier !
il fallait donc télécharger l'application
http://www.7-zip.org/dl/7z420.exe
et (le premier n'est peut être pas nécessaire)
http://prdownloads.sourceforge.net/sevenzip/7za420.zip
pour avoir la version ligne commande "7za.exe"
Je copie le contenu de l'archive dans C:Program Files7-Zip
relance le truc et plante à
Function Attachtype(ByVal strEntryID As String, attindex As Integer)
As Variant
Dim oSession As MAPI.Session
erreur de compilation : type défini par l'utilisateur non défini.
J'imagine que c'est la maudite dll (cdo.dll) qui me manque ...
pfff :-(
Je remarque aussi que le boulot est fait (presque fini), la pièce
jointe est bien dans c:tempziptemp, le zip aussi ...
Si t'as un solution, merci
@+lolo (qui ne sait pas utiliser les infos trouvées sur mpfe)
Bonjour Oliv',
Je te compte mon histoire suite ta réponse
au pire tu remplaces
typeatt = Attachtype(strEntryID, objAtt.index)
par typeatt =""
je plante un peu plus loin, ici
resultat = objShell.Run(tacommande, 1, True)
Erreur d'éxécution '-2147024894 (80070002)':
La méthode 'Run' de l'objet 'IWshShell3' a échoué
Je note que :
7-zip (version 4.32) est installé et fonctionne
dans ta variable "tacommande" tu fais appel à 7za.exe
bien que dans le readme.txt je puisse lire
This distrubutive packet contains the following files:
...
7za.exe - 7-Zip standalone command line version
...
je n'ai pas ce fichier !
il fallait donc télécharger l'application
http://www.7-zip.org/dl/7z420.exe
et (le premier n'est peut être pas nécessaire)
http://prdownloads.sourceforge.net/sevenzip/7za420.zip
pour avoir la version ligne commande "7za.exe"
Je copie le contenu de l'archive dans C:Program Files7-Zip
relance le truc et plante à
Function Attachtype(ByVal strEntryID As String, attindex As Integer)
As Variant
Dim oSession As MAPI.Session
erreur de compilation : type défini par l'utilisateur non défini.
J'imagine que c'est la maudite dll (cdo.dll) qui me manque ...
pfff :-(
Je remarque aussi que le boulot est fait (presque fini), la pièce
jointe est bien dans c:tempziptemp, le zip aussi ...
Si t'as un solution, merci
@+lolo (qui ne sait pas utiliser les infos trouvées sur mpfe)
Bonjour Oliv',
Je te compte mon histoire suite ta réponseau pire tu remplaces
typeatt = Attachtype(strEntryID, objAtt.index)
par typeatt =""
je plante un peu plus loin, ici
resultat = objShell.Run(tacommande, 1, True)
Erreur d'éxécution '-2147024894 (80070002)':
La méthode 'Run' de l'objet 'IWshShell3' a échoué
Je note que :
7-zip (version 4.32) est installé et fonctionne
dans ta variable "tacommande" tu fais appel à 7za.exe
bien que dans le readme.txt je puisse lire
This distrubutive packet contains the following files:
...
7za.exe - 7-Zip standalone command line version
...
je n'ai pas ce fichier !
il fallait donc télécharger l'application
http://www.7-zip.org/dl/7z420.exe
et (le premier n'est peut être pas nécessaire)
http://prdownloads.sourceforge.net/sevenzip/7za420.zip
pour avoir la version ligne commande "7za.exe"
Je copie le contenu de l'archive dans C:Program Files7-Zip
relance le truc et plante à
Function Attachtype(ByVal strEntryID As String, attindex As Integer)
As Variant
Dim oSession As MAPI.Session
erreur de compilation : type défini par l'utilisateur non défini.
J'imagine que c'est la maudite dll (cdo.dll) qui me manque ...
pfff :-(
Je remarque aussi que le boulot est fait (presque fini), la pièce
jointe est bien dans c:tempziptemp, le zip aussi ...
Si t'as un solution, merci
@+lolo (qui ne sait pas utiliser les infos trouvées sur mpfe)
"David" a écrit dans le message de news:Tous mes remerciements Olivier !
Cependant, au risque de paraitre ennuyeux, il s'avère que je ne sais pas
du
tout que faire avec ces éléments que tu viens de me communiquer, étant,
pour
ainsi dire, une sorte "d'utilisateur final".
tu sais je suis quasiment autodidacte, on peut toujours apprendre à faire!!
mais bon c'est gratuit donc faut mettre la main à la patte.
Faut donc installer 7-ZIP.
Puis dans outlook tu appuyes sur alt+F11. ca ouvre le gestionnaire de macro
VBE.
tu cliques dans le menu sur insertion / module
si tu fais un copier coller ci-dessous de "sub zip" à "End Function",
tu auras des erreurs à cause du retour à ligne après 76 caractères (les
lignes en rouge) en plus faut supprimer les ">>"
alors rècupère le code sur
http://212.11.50.28/~olivier/sub_zip.bas
et
http://212.11.50.28/~olivier/Fonctions%20type%20attachment.bas
que tu mets à la suite dans le module
[il manquait un bout de code que j'ai mis dans le deuxième lien.
Sub GetSelectedItems()
Dim myOlApp As New Outlook.Application
Dim myOlExp As Outlook.Explorer
Dim myOlSel As Outlook.Selection
Dim MsgTxt As String
Dim x As Integer
MsgTxt = "Vous devez selectionner un seul mail"
Set myOlExp = myOlApp.ActiveExplorer
Set myOlSel = myOlExp.Selection
x = myOlSel.Count
If x <> 1 Then
MsgBox MsgTxt
Exit Sub
End If
myOlSel.Item(x).Display
End Sub]
Il faut ajouter une référence à "Microsoft CDO 1.21 LIBRARY" en cochant la
case dans outils références.
tu fermes cette fenêtre puis
dans OUTLOOK / macro/securite
tu coches "niveau Moyen".
Tu ouvres un mail .
Tu cliques bouton droit sur la barre des icones / personnaliser
DAns catégorie tu te positionnes sur macros et à droite tu vas voir
PROJET1.zip
tu le prends avec ta souris et tu le poses dans la barre des icones.
tu fermes toutes les fenetres outlook. et réponds OUI à [Voulez-vous
enregistrer le projet VBA 'ThisOutlooksession']
tu réouvres OUTLOOK .
tu ouvres ou tu créés le mail dont tu veux zipper les pièces jointes
tu cliquez sur l'icone "zip" créé
au "security warning" tu cliques "activer les macros"
Et voilà !!!!
je pense ne rien avoir oublié.
--
--
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Have a nice day
Oliv'
Pour me joindre : http://cerbermail.com/?V8r2o1YHl4
les sites références:
Excel :http://www.excelabo.net http://xcell05.free.fr/
http://dj.joss.free.fr/
http://frederic.sigonneau.free.fr/ http://www.excel-vba-francais.com/
Word : http://faqword.free.fr/
Outlook :http://faq.outlook.free.fr/
Sql :http://sqlpro.developpez.com/
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~En espérant ne pas trop abuser de ton temps,
DavidBonjour,
Notre entreprise tourne sous Outlook 2000 et dans le cadre de notre
activité nous recevons de très nombreux mails contenant des pièces
jointes par jours.
Je recherche un moyen de sauvegarder les pièces jointes d'un mail
particulier au sein d'un seul et même fichier d'archives ZIP. Par
exemple par le biais d'un add-on qui afficherait sur l'interface de
lecture du mail un bouton dédié à cet effet.
J'avais trouvé sur le net "Outlook Attachment Sniffer" mais ce
logiciel, bien que très complet, n'offre pas la fonction que je
recherche. En effet, il gère le traitement par lot des mails, et pas
la gestion au cas par cas.
Je vous en remercie par avance.
je viens d'écrire un truc dans ce genre pour outlook 2003 avec lancement
par
un icone
avec notamment l'aide de sources de Sue Mosher et de son excellent site
http://www.outlookcode.com/ et de bastanu sur www.vbforums.com
..
il faut 7zip sur www.7-zip.org
un formulaire nommé "attente" pour faire patienter ou mettre un ' devant
les
lignes concernées.
un repertoire "c:temp"
confirmer à la fermeture l'enregistrement
ca marche sur les nouveau mail et les mails déjà recus ou envoyés.
Pour parfaire le tout tu peux ajouter cette macro avec un test sur la
taille du mail dans l'evenement application_itemsend .
La fonction Attachtype a également des utilisations très interessantes
pour
différencier les images insérées au sein des pièces jointes.
Voici donc ma contribution !!!
MERCI DE ME FAIRE REMONTER SON UTILISATION ET SES BUG EVENTUELS
' zip les pieces jointes du mail
Sub ZIP()
' création OLIVIER CATTEAU 2006
On Error Resume Next
Load Attente
Attente.Label2 = "ETAPE 1/3"
Dim liste
'parcours des fichiers attachés
################################################################################
Dim objAtt As Attachment, objAtts As Attachments, objCurrentMessage
As
MailItem
If Application.ActiveInspector Is Nothing Then GetSelectedItems
Set objCurrentMessage = ActiveInspector.CurrentItem
Set objAtts = objCurrentMessage.Attachments
nb_attach = objAtts.Count
If nb_attach = 0 Then
erreur = "Pas de fichiers joints"
GoTo fin
End If
Attente.Show vbModeless
On Error GoTo 0
'on crée le repertoire où mettre les fichiers joints
##########################################################
repertoire = "c:tempziptemp" & ""
If repertoire <> "" Then
If "" = Dir(repertoire, vbDirectory) Then
MkDir repertoire
Else
On Error Resume Next
Kill repertoire & "*.*"
On Error GoTo 0
End If
End If
'#################################Traitement des fichiers joints
###################################################
'liste = ""
Dim strEntryID As String
If objCurrentMessage.EntryID = "" Then objCurrentMessage.Save
strEntryID = objCurrentMessage.EntryID
For Each objAtt In objAtts
typeatt = Attachtype(strEntryID, objAtt.index)
If typeatt <> "" Or UCase(Right(objAtt.FileName, 3)) = "ZIP" Then
MsgBox " [" & objAtt.FileName & "] est une image insérée ou est
déjà
un ZIP" & vbCr & " cette pièce ne sera pas zippée"
nb_embedded = nb_embedded + 1
Else
'ajoutter un controle dir sur le fichier et mettre l'index devant
le
nom pour les doublons
objAtt.SaveAsFile repertoire & Replace(objAtt.FileName, "?",
"euro")
liste = liste & "{" & objAtt.FileName & "}"
End If
Next
' zippe les documents
If nb_attach > nb_embedded Then
Dim objShell As Object
Set objShell = CreateObject("WScript.Shell")
On Error Resume Next
ExistDoc = nb_attach - nb_embedded & "documents.zip"
If ExistDoc <> objAtts(ExistDoc) Then
ExistDoc = nb_attach - nb_embedded & "documents.zip"
Else
ExistDoc = "documents.zip"
End If
On Error GoTo 0
tacommande = """C:Program Files7-Zip7za"" a -tzip c:tempziptemp"
&
ExistDoc & " " & repertoire & "*.*"
' pour volume multiple si + 2 mo
'TaCommande = """C:Program Files7-Zip7za"" a -tzip -v2m
c:tempziptempdocuments.zip " & repertoire & "*.*"
resultat = objShell.Run(tacommande, 1, True) ' ne rendra la main
qu'une
fois terminé
If resultat = 0 Then
'supprime les pieces jointes
Do While objAtts.Count > nb_embedded ' Boucle interne.
For Each truc In objAtts
typeatt = Attachtype(strEntryID, truc.index)
If typeatt = "" And UCase(Right(truc.FileName, 3)) <> "ZIP" Then
objAtts.Remove (truc.index)
Exit For ' Quitte la boucle interne.
End If
Next truc
Loop
'méthode pour tout supprimer.
'While objAtts.Count > 0
'objAtts.Remove 1
'Wend
objAtts.Add Source:="c:tempziptemp" & ExistDoc, Type:=olByValue
liste = "[Contenu de " & ExistDoc & " : " & nb_attach - nb_embedded &
"
document(s) :<br>" & liste & "]<br>"
If objAtts.Parent.BodyFormat = olFormatHTML Then
objAtts.Parent.HTMLBody = "<HTML>" & liste & "<br>" &
objCurrentMessage.HTMLBody
Else: objCurrentMessage.Body = Replace(liste, "<br>", vbCr) &
objCurrentMessage.Body
End If
'supprimes mes fichiers temporaires
On Error Resume Next
Kill repertoire & "*.*"
Set objShell = Nothing
Else: erreur = "erreur de compression " & vbCr & "Merci de le signaler
à
Olivier"
End If
End If
fin:
On Error Resume Next
If erreur <> "" Then
MsgBox erreur, vbCritical, "Fin de traitement"
Else
'MsgBox "Traitement terminé"
End If
Attente.Label2 = "Terminé"
Attente.Repaint
Unload Attente
Set resultat = Nothing
Set erreur = Nothing
Set objCurrentMessage = Nothing
Set objAtts = Nothing
Set nb_attach = Nothing
Set tacommande = Nothing
Set liste = Nothing
End Sub
' Function: Fields_Selector
' Purpose: View type of attachment
' olivier catteau fevrier 2006
Function Attachtype(ByVal strEntryID As String, attindex As Integer) As
Variant
Dim oSession As MAPI.Session
' CDO objects
Dim oMsg As MAPI.Message
Dim oAttachs As MAPI.Attachments
"David" <David@discussions.microsoft.com> a écrit dans le message de news:
DF246063-71E6-4532-A45F-CD1E208AFAD5@microsoft.com...
Tous mes remerciements Olivier !
Cependant, au risque de paraitre ennuyeux, il s'avère que je ne sais pas
du
tout que faire avec ces éléments que tu viens de me communiquer, étant,
pour
ainsi dire, une sorte "d'utilisateur final".
tu sais je suis quasiment autodidacte, on peut toujours apprendre à faire!!
mais bon c'est gratuit donc faut mettre la main à la patte.
Faut donc installer 7-ZIP.
Puis dans outlook tu appuyes sur alt+F11. ca ouvre le gestionnaire de macro
VBE.
tu cliques dans le menu sur insertion / module
si tu fais un copier coller ci-dessous de "sub zip" à "End Function",
tu auras des erreurs à cause du retour à ligne après 76 caractères (les
lignes en rouge) en plus faut supprimer les ">>"
alors rècupère le code sur
http://212.11.50.28/~olivier/sub_zip.bas
et
http://212.11.50.28/~olivier/Fonctions%20type%20attachment.bas
que tu mets à la suite dans le module
[il manquait un bout de code que j'ai mis dans le deuxième lien.
Sub GetSelectedItems()
Dim myOlApp As New Outlook.Application
Dim myOlExp As Outlook.Explorer
Dim myOlSel As Outlook.Selection
Dim MsgTxt As String
Dim x As Integer
MsgTxt = "Vous devez selectionner un seul mail"
Set myOlExp = myOlApp.ActiveExplorer
Set myOlSel = myOlExp.Selection
x = myOlSel.Count
If x <> 1 Then
MsgBox MsgTxt
Exit Sub
End If
myOlSel.Item(x).Display
End Sub]
Il faut ajouter une référence à "Microsoft CDO 1.21 LIBRARY" en cochant la
case dans outils références.
tu fermes cette fenêtre puis
dans OUTLOOK / macro/securite
tu coches "niveau Moyen".
Tu ouvres un mail .
Tu cliques bouton droit sur la barre des icones / personnaliser
DAns catégorie tu te positionnes sur macros et à droite tu vas voir
PROJET1.zip
tu le prends avec ta souris et tu le poses dans la barre des icones.
tu fermes toutes les fenetres outlook. et réponds OUI à [Voulez-vous
enregistrer le projet VBA 'ThisOutlooksession']
tu réouvres OUTLOOK .
tu ouvres ou tu créés le mail dont tu veux zipper les pièces jointes
tu cliquez sur l'icone "zip" créé
au "security warning" tu cliques "activer les macros"
Et voilà !!!!
je pense ne rien avoir oublié.
--
--
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Have a nice day
Oliv'
Pour me joindre : http://cerbermail.com/?V8r2o1YHl4
les sites références:
Excel :http://www.excelabo.net http://xcell05.free.fr/
http://dj.joss.free.fr/
http://frederic.sigonneau.free.fr/ http://www.excel-vba-francais.com/
Word : http://faqword.free.fr/
Outlook :http://faq.outlook.free.fr/
Sql :http://sqlpro.developpez.com/
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
En espérant ne pas trop abuser de ton temps,
David
Bonjour,
Notre entreprise tourne sous Outlook 2000 et dans le cadre de notre
activité nous recevons de très nombreux mails contenant des pièces
jointes par jours.
Je recherche un moyen de sauvegarder les pièces jointes d'un mail
particulier au sein d'un seul et même fichier d'archives ZIP. Par
exemple par le biais d'un add-on qui afficherait sur l'interface de
lecture du mail un bouton dédié à cet effet.
J'avais trouvé sur le net "Outlook Attachment Sniffer" mais ce
logiciel, bien que très complet, n'offre pas la fonction que je
recherche. En effet, il gère le traitement par lot des mails, et pas
la gestion au cas par cas.
Je vous en remercie par avance.
je viens d'écrire un truc dans ce genre pour outlook 2003 avec lancement
par
un icone
avec notamment l'aide de sources de Sue Mosher et de son excellent site
http://www.outlookcode.com/ et de bastanu sur www.vbforums.com
..
il faut 7zip sur www.7-zip.org
un formulaire nommé "attente" pour faire patienter ou mettre un ' devant
les
lignes concernées.
un repertoire "c:temp"
confirmer à la fermeture l'enregistrement
ca marche sur les nouveau mail et les mails déjà recus ou envoyés.
Pour parfaire le tout tu peux ajouter cette macro avec un test sur la
taille du mail dans l'evenement application_itemsend .
La fonction Attachtype a également des utilisations très interessantes
pour
différencier les images insérées au sein des pièces jointes.
Voici donc ma contribution !!!
MERCI DE ME FAIRE REMONTER SON UTILISATION ET SES BUG EVENTUELS
' zip les pieces jointes du mail
Sub ZIP()
' création OLIVIER CATTEAU 2006
On Error Resume Next
Load Attente
Attente.Label2 = "ETAPE 1/3"
Dim liste
'parcours des fichiers attachés
################################################################################
Dim objAtt As Attachment, objAtts As Attachments, objCurrentMessage
As
MailItem
If Application.ActiveInspector Is Nothing Then GetSelectedItems
Set objCurrentMessage = ActiveInspector.CurrentItem
Set objAtts = objCurrentMessage.Attachments
nb_attach = objAtts.Count
If nb_attach = 0 Then
erreur = "Pas de fichiers joints"
GoTo fin
End If
Attente.Show vbModeless
On Error GoTo 0
'on crée le repertoire où mettre les fichiers joints
##########################################################
repertoire = "c:tempziptemp" & ""
If repertoire <> "" Then
If "" = Dir(repertoire, vbDirectory) Then
MkDir repertoire
Else
On Error Resume Next
Kill repertoire & "*.*"
On Error GoTo 0
End If
End If
'#################################Traitement des fichiers joints
###################################################
'liste = ""
Dim strEntryID As String
If objCurrentMessage.EntryID = "" Then objCurrentMessage.Save
strEntryID = objCurrentMessage.EntryID
For Each objAtt In objAtts
typeatt = Attachtype(strEntryID, objAtt.index)
If typeatt <> "" Or UCase(Right(objAtt.FileName, 3)) = "ZIP" Then
MsgBox " [" & objAtt.FileName & "] est une image insérée ou est
déjà
un ZIP" & vbCr & " cette pièce ne sera pas zippée"
nb_embedded = nb_embedded + 1
Else
'ajoutter un controle dir sur le fichier et mettre l'index devant
le
nom pour les doublons
objAtt.SaveAsFile repertoire & Replace(objAtt.FileName, "?",
"euro")
liste = liste & "{" & objAtt.FileName & "}"
End If
Next
' zippe les documents
If nb_attach > nb_embedded Then
Dim objShell As Object
Set objShell = CreateObject("WScript.Shell")
On Error Resume Next
ExistDoc = nb_attach - nb_embedded & "documents.zip"
If ExistDoc <> objAtts(ExistDoc) Then
ExistDoc = nb_attach - nb_embedded & "documents.zip"
Else
ExistDoc = "documents.zip"
End If
On Error GoTo 0
tacommande = """C:Program Files7-Zip7za"" a -tzip c:tempziptemp"
&
ExistDoc & " " & repertoire & "*.*"
' pour volume multiple si + 2 mo
'TaCommande = """C:Program Files7-Zip7za"" a -tzip -v2m
c:tempziptempdocuments.zip " & repertoire & "*.*"
resultat = objShell.Run(tacommande, 1, True) ' ne rendra la main
qu'une
fois terminé
If resultat = 0 Then
'supprime les pieces jointes
Do While objAtts.Count > nb_embedded ' Boucle interne.
For Each truc In objAtts
typeatt = Attachtype(strEntryID, truc.index)
If typeatt = "" And UCase(Right(truc.FileName, 3)) <> "ZIP" Then
objAtts.Remove (truc.index)
Exit For ' Quitte la boucle interne.
End If
Next truc
Loop
'méthode pour tout supprimer.
'While objAtts.Count > 0
'objAtts.Remove 1
'Wend
objAtts.Add Source:="c:tempziptemp" & ExistDoc, Type:=olByValue
liste = "[Contenu de " & ExistDoc & " : " & nb_attach - nb_embedded &
"
document(s) :<br>" & liste & "]<br>"
If objAtts.Parent.BodyFormat = olFormatHTML Then
objAtts.Parent.HTMLBody = "<HTML>" & liste & "<br>" &
objCurrentMessage.HTMLBody
Else: objCurrentMessage.Body = Replace(liste, "<br>", vbCr) &
objCurrentMessage.Body
End If
'supprimes mes fichiers temporaires
On Error Resume Next
Kill repertoire & "*.*"
Set objShell = Nothing
Else: erreur = "erreur de compression " & vbCr & "Merci de le signaler
à
Olivier"
End If
End If
fin:
On Error Resume Next
If erreur <> "" Then
MsgBox erreur, vbCritical, "Fin de traitement"
Else
'MsgBox "Traitement terminé"
End If
Attente.Label2 = "Terminé"
Attente.Repaint
Unload Attente
Set resultat = Nothing
Set erreur = Nothing
Set objCurrentMessage = Nothing
Set objAtts = Nothing
Set nb_attach = Nothing
Set tacommande = Nothing
Set liste = Nothing
End Sub
' Function: Fields_Selector
' Purpose: View type of attachment
' olivier catteau fevrier 2006
Function Attachtype(ByVal strEntryID As String, attindex As Integer) As
Variant
Dim oSession As MAPI.Session
' CDO objects
Dim oMsg As MAPI.Message
Dim oAttachs As MAPI.Attachments
"David" a écrit dans le message de news:Tous mes remerciements Olivier !
Cependant, au risque de paraitre ennuyeux, il s'avère que je ne sais pas
du
tout que faire avec ces éléments que tu viens de me communiquer, étant,
pour
ainsi dire, une sorte "d'utilisateur final".
tu sais je suis quasiment autodidacte, on peut toujours apprendre à faire!!
mais bon c'est gratuit donc faut mettre la main à la patte.
Faut donc installer 7-ZIP.
Puis dans outlook tu appuyes sur alt+F11. ca ouvre le gestionnaire de macro
VBE.
tu cliques dans le menu sur insertion / module
si tu fais un copier coller ci-dessous de "sub zip" à "End Function",
tu auras des erreurs à cause du retour à ligne après 76 caractères (les
lignes en rouge) en plus faut supprimer les ">>"
alors rècupère le code sur
http://212.11.50.28/~olivier/sub_zip.bas
et
http://212.11.50.28/~olivier/Fonctions%20type%20attachment.bas
que tu mets à la suite dans le module
[il manquait un bout de code que j'ai mis dans le deuxième lien.
Sub GetSelectedItems()
Dim myOlApp As New Outlook.Application
Dim myOlExp As Outlook.Explorer
Dim myOlSel As Outlook.Selection
Dim MsgTxt As String
Dim x As Integer
MsgTxt = "Vous devez selectionner un seul mail"
Set myOlExp = myOlApp.ActiveExplorer
Set myOlSel = myOlExp.Selection
x = myOlSel.Count
If x <> 1 Then
MsgBox MsgTxt
Exit Sub
End If
myOlSel.Item(x).Display
End Sub]
Il faut ajouter une référence à "Microsoft CDO 1.21 LIBRARY" en cochant la
case dans outils références.
tu fermes cette fenêtre puis
dans OUTLOOK / macro/securite
tu coches "niveau Moyen".
Tu ouvres un mail .
Tu cliques bouton droit sur la barre des icones / personnaliser
DAns catégorie tu te positionnes sur macros et à droite tu vas voir
PROJET1.zip
tu le prends avec ta souris et tu le poses dans la barre des icones.
tu fermes toutes les fenetres outlook. et réponds OUI à [Voulez-vous
enregistrer le projet VBA 'ThisOutlooksession']
tu réouvres OUTLOOK .
tu ouvres ou tu créés le mail dont tu veux zipper les pièces jointes
tu cliquez sur l'icone "zip" créé
au "security warning" tu cliques "activer les macros"
Et voilà !!!!
je pense ne rien avoir oublié.
--
--
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Have a nice day
Oliv'
Pour me joindre : http://cerbermail.com/?V8r2o1YHl4
les sites références:
Excel :http://www.excelabo.net http://xcell05.free.fr/
http://dj.joss.free.fr/
http://frederic.sigonneau.free.fr/ http://www.excel-vba-francais.com/
Word : http://faqword.free.fr/
Outlook :http://faq.outlook.free.fr/
Sql :http://sqlpro.developpez.com/
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~En espérant ne pas trop abuser de ton temps,
DavidBonjour,
Notre entreprise tourne sous Outlook 2000 et dans le cadre de notre
activité nous recevons de très nombreux mails contenant des pièces
jointes par jours.
Je recherche un moyen de sauvegarder les pièces jointes d'un mail
particulier au sein d'un seul et même fichier d'archives ZIP. Par
exemple par le biais d'un add-on qui afficherait sur l'interface de
lecture du mail un bouton dédié à cet effet.
J'avais trouvé sur le net "Outlook Attachment Sniffer" mais ce
logiciel, bien que très complet, n'offre pas la fonction que je
recherche. En effet, il gère le traitement par lot des mails, et pas
la gestion au cas par cas.
Je vous en remercie par avance.
je viens d'écrire un truc dans ce genre pour outlook 2003 avec lancement
par
un icone
avec notamment l'aide de sources de Sue Mosher et de son excellent site
http://www.outlookcode.com/ et de bastanu sur www.vbforums.com
..
il faut 7zip sur www.7-zip.org
un formulaire nommé "attente" pour faire patienter ou mettre un ' devant
les
lignes concernées.
un repertoire "c:temp"
confirmer à la fermeture l'enregistrement
ca marche sur les nouveau mail et les mails déjà recus ou envoyés.
Pour parfaire le tout tu peux ajouter cette macro avec un test sur la
taille du mail dans l'evenement application_itemsend .
La fonction Attachtype a également des utilisations très interessantes
pour
différencier les images insérées au sein des pièces jointes.
Voici donc ma contribution !!!
MERCI DE ME FAIRE REMONTER SON UTILISATION ET SES BUG EVENTUELS
' zip les pieces jointes du mail
Sub ZIP()
' création OLIVIER CATTEAU 2006
On Error Resume Next
Load Attente
Attente.Label2 = "ETAPE 1/3"
Dim liste
'parcours des fichiers attachés
################################################################################
Dim objAtt As Attachment, objAtts As Attachments, objCurrentMessage
As
MailItem
If Application.ActiveInspector Is Nothing Then GetSelectedItems
Set objCurrentMessage = ActiveInspector.CurrentItem
Set objAtts = objCurrentMessage.Attachments
nb_attach = objAtts.Count
If nb_attach = 0 Then
erreur = "Pas de fichiers joints"
GoTo fin
End If
Attente.Show vbModeless
On Error GoTo 0
'on crée le repertoire où mettre les fichiers joints
##########################################################
repertoire = "c:tempziptemp" & ""
If repertoire <> "" Then
If "" = Dir(repertoire, vbDirectory) Then
MkDir repertoire
Else
On Error Resume Next
Kill repertoire & "*.*"
On Error GoTo 0
End If
End If
'#################################Traitement des fichiers joints
###################################################
'liste = ""
Dim strEntryID As String
If objCurrentMessage.EntryID = "" Then objCurrentMessage.Save
strEntryID = objCurrentMessage.EntryID
For Each objAtt In objAtts
typeatt = Attachtype(strEntryID, objAtt.index)
If typeatt <> "" Or UCase(Right(objAtt.FileName, 3)) = "ZIP" Then
MsgBox " [" & objAtt.FileName & "] est une image insérée ou est
déjà
un ZIP" & vbCr & " cette pièce ne sera pas zippée"
nb_embedded = nb_embedded + 1
Else
'ajoutter un controle dir sur le fichier et mettre l'index devant
le
nom pour les doublons
objAtt.SaveAsFile repertoire & Replace(objAtt.FileName, "?",
"euro")
liste = liste & "{" & objAtt.FileName & "}"
End If
Next
' zippe les documents
If nb_attach > nb_embedded Then
Dim objShell As Object
Set objShell = CreateObject("WScript.Shell")
On Error Resume Next
ExistDoc = nb_attach - nb_embedded & "documents.zip"
If ExistDoc <> objAtts(ExistDoc) Then
ExistDoc = nb_attach - nb_embedded & "documents.zip"
Else
ExistDoc = "documents.zip"
End If
On Error GoTo 0
tacommande = """C:Program Files7-Zip7za"" a -tzip c:tempziptemp"
&
ExistDoc & " " & repertoire & "*.*"
' pour volume multiple si + 2 mo
'TaCommande = """C:Program Files7-Zip7za"" a -tzip -v2m
c:tempziptempdocuments.zip " & repertoire & "*.*"
resultat = objShell.Run(tacommande, 1, True) ' ne rendra la main
qu'une
fois terminé
If resultat = 0 Then
'supprime les pieces jointes
Do While objAtts.Count > nb_embedded ' Boucle interne.
For Each truc In objAtts
typeatt = Attachtype(strEntryID, truc.index)
If typeatt = "" And UCase(Right(truc.FileName, 3)) <> "ZIP" Then
objAtts.Remove (truc.index)
Exit For ' Quitte la boucle interne.
End If
Next truc
Loop
'méthode pour tout supprimer.
'While objAtts.Count > 0
'objAtts.Remove 1
'Wend
objAtts.Add Source:="c:tempziptemp" & ExistDoc, Type:=olByValue
liste = "[Contenu de " & ExistDoc & " : " & nb_attach - nb_embedded &
"
document(s) :<br>" & liste & "]<br>"
If objAtts.Parent.BodyFormat = olFormatHTML Then
objAtts.Parent.HTMLBody = "<HTML>" & liste & "<br>" &
objCurrentMessage.HTMLBody
Else: objCurrentMessage.Body = Replace(liste, "<br>", vbCr) &
objCurrentMessage.Body
End If
'supprimes mes fichiers temporaires
On Error Resume Next
Kill repertoire & "*.*"
Set objShell = Nothing
Else: erreur = "erreur de compression " & vbCr & "Merci de le signaler
à
Olivier"
End If
End If
fin:
On Error Resume Next
If erreur <> "" Then
MsgBox erreur, vbCritical, "Fin de traitement"
Else
'MsgBox "Traitement terminé"
End If
Attente.Label2 = "Terminé"
Attente.Repaint
Unload Attente
Set resultat = Nothing
Set erreur = Nothing
Set objCurrentMessage = Nothing
Set objAtts = Nothing
Set nb_attach = Nothing
Set tacommande = Nothing
Set liste = Nothing
End Sub
' Function: Fields_Selector
' Purpose: View type of attachment
' olivier catteau fevrier 2006
Function Attachtype(ByVal strEntryID As String, attindex As Integer) As
Variant
Dim oSession As MAPI.Session
' CDO objects
Dim oMsg As MAPI.Message
Dim oAttachs As MAPI.Attachments
Bonjour Olivier,
Merci beaucoup pour ce mode d'emploi détaillé.
Il s'avère que dans la référence je n'ai pas la librairie que tu
cite, mais la Microsoft CDO for Windows 2000 library, je l'ai donc
activée.
Au final, un clic sur le bouton créé ne donne strictement aucun
action, ni aucune erreur.
Pour mémoire, j'utilise Outlook 2000.
A plus tard.
David
"David" a écrit dans le message de
news:Tous mes remerciements Olivier !
Cependant, au risque de paraitre ennuyeux, il s'avère que je ne
sais pas du
tout que faire avec ces éléments que tu viens de me communiquer,
étant, pour
ainsi dire, une sorte "d'utilisateur final".
tu sais je suis quasiment autodidacte, on peut toujours apprendre à
faire!! mais bon c'est gratuit donc faut mettre la main à la patte.
Faut donc installer 7-ZIP.
Puis dans outlook tu appuyes sur alt+F11. ca ouvre le gestionnaire
de macro VBE.
tu cliques dans le menu sur insertion / module
si tu fais un copier coller ci-dessous de "sub zip" à "End
Function",
tu auras des erreurs à cause du retour à ligne après 76 caractères
(les lignes en rouge) en plus faut supprimer les ">>"
alors rècupère le code sur
http://212.11.50.28/~olivier/sub_zip.bas
et
http://212.11.50.28/~olivier/Fonctions%20type%20attachment.bas
que tu mets à la suite dans le module
[il manquait un bout de code que j'ai mis dans le deuxième lien.
Sub GetSelectedItems()
Dim myOlApp As New Outlook.Application
Dim myOlExp As Outlook.Explorer
Dim myOlSel As Outlook.Selection
Dim MsgTxt As String
Dim x As Integer
MsgTxt = "Vous devez selectionner un seul mail"
Set myOlExp = myOlApp.ActiveExplorer
Set myOlSel = myOlExp.Selection
x = myOlSel.Count
If x <> 1 Then
MsgBox MsgTxt
Exit Sub
End If
myOlSel.Item(x).Display
End Sub]
Il faut ajouter une référence à "Microsoft CDO 1.21 LIBRARY" en
cochant la case dans outils références.
tu fermes cette fenêtre puis
dans OUTLOOK / macro/securite
tu coches "niveau Moyen".
Tu ouvres un mail .
Tu cliques bouton droit sur la barre des icones / personnaliser
DAns catégorie tu te positionnes sur macros et à droite tu vas voir
PROJET1.zip
tu le prends avec ta souris et tu le poses dans la barre des icones.
tu fermes toutes les fenetres outlook. et réponds OUI à [Voulez-vous
enregistrer le projet VBA 'ThisOutlooksession']
tu réouvres OUTLOOK .
tu ouvres ou tu créés le mail dont tu veux zipper les pièces jointes
tu cliquez sur l'icone "zip" créé
au "security warning" tu cliques "activer les macros"
Et voilà !!!!
je pense ne rien avoir oublié.
--
--
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Have a nice day
Oliv'
Pour me joindre : http://cerbermail.com/?V8r2o1YHl4
les sites références:
Excel :http://www.excelabo.net http://xcell05.free.fr/
http://dj.joss.free.fr/
http://frederic.sigonneau.free.fr/ http://www.excel-vba-francais.com/
Word : http://faqword.free.fr/
Outlook :http://faq.outlook.free.fr/
Sql :http://sqlpro.developpez.com/
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~En espérant ne pas trop abuser de ton temps,
DavidBonjour,
Notre entreprise tourne sous Outlook 2000 et dans le cadre de
notre activité nous recevons de très nombreux mails contenant des
pièces jointes par jours.
Je recherche un moyen de sauvegarder les pièces jointes d'un mail
particulier au sein d'un seul et même fichier d'archives ZIP. Par
exemple par le biais d'un add-on qui afficherait sur l'interface
de lecture du mail un bouton dédié à cet effet.
J'avais trouvé sur le net "Outlook Attachment Sniffer" mais ce
logiciel, bien que très complet, n'offre pas la fonction que je
recherche. En effet, il gère le traitement par lot des mails, et
pas la gestion au cas par cas.
Je vous en remercie par avance.
je viens d'écrire un truc dans ce genre pour outlook 2003 avec
lancement par
un icone
avec notamment l'aide de sources de Sue Mosher et de son excellent
site http://www.outlookcode.com/ et de bastanu sur www.vbforums.com
..
il faut 7zip sur www.7-zip.org
un formulaire nommé "attente" pour faire patienter ou mettre un '
devant les
lignes concernées.
un repertoire "c:temp"
confirmer à la fermeture l'enregistrement
ca marche sur les nouveau mail et les mails déjà recus ou envoyés.
Pour parfaire le tout tu peux ajouter cette macro avec un test
sur la taille du mail dans l'evenement application_itemsend .
La fonction Attachtype a également des utilisations très
interessantes pour
différencier les images insérées au sein des pièces jointes.
Voici donc ma contribution !!!
MERCI DE ME FAIRE REMONTER SON UTILISATION ET SES BUG EVENTUELS
' zip les pieces jointes du mail
Sub ZIP()
' création OLIVIER CATTEAU 2006
On Error Resume Next
Load Attente
Attente.Label2 = "ETAPE 1/3"
Dim liste
'parcours des fichiers attachés
################################################################################
Dim objAtt As Attachment, objAtts As Attachments,
objCurrentMessage As
MailItem
If Application.ActiveInspector Is Nothing Then GetSelectedItems
Set objCurrentMessage = ActiveInspector.CurrentItem
Set objAtts = objCurrentMessage.Attachments
nb_attach = objAtts.Count
If nb_attach = 0 Then
erreur = "Pas de fichiers joints"
GoTo fin
End If
Attente.Show vbModeless
On Error GoTo 0
'on crée le repertoire où mettre les fichiers joints
##########################################################
repertoire = "c:tempziptemp" & ""
If repertoire <> "" Then
If "" = Dir(repertoire, vbDirectory) Then
MkDir repertoire
Else
On Error Resume Next
Kill repertoire & "*.*"
On Error GoTo 0
End If
End If
'#################################Traitement des fichiers
joints ###################################################
'liste = ""
Dim strEntryID As String
If objCurrentMessage.EntryID = "" Then objCurrentMessage.Save
strEntryID = objCurrentMessage.EntryID
For Each objAtt In objAtts
typeatt = Attachtype(strEntryID, objAtt.index)
If typeatt <> "" Or UCase(Right(objAtt.FileName, 3)) >>>> "ZIP" Then MsgBox " [" & objAtt.FileName & "] est une
image insérée ou est
déjà
un ZIP" & vbCr & " cette pièce ne sera pas zippée"
nb_embedded = nb_embedded + 1
Else
'ajoutter un controle dir sur le fichier et mettre l'index
devant le
nom pour les doublons
objAtt.SaveAsFile repertoire & Replace(objAtt.FileName,
"?", "euro")
liste = liste & "{" & objAtt.FileName & "}"
End If
Next
' zippe les documents
If nb_attach > nb_embedded Then
Dim objShell As Object
Set objShell = CreateObject("WScript.Shell")
On Error Resume Next
ExistDoc = nb_attach - nb_embedded & "documents.zip"
If ExistDoc <> objAtts(ExistDoc) Then
ExistDoc = nb_attach - nb_embedded & "documents.zip"
Else
ExistDoc = "documents.zip"
End If
On Error GoTo 0
tacommande = """C:Program Files7-Zip7za"" a -tzip
c:tempziptemp" &
ExistDoc & " " & repertoire & "*.*"
' pour volume multiple si + 2 mo
'TaCommande = """C:Program Files7-Zip7za"" a -tzip -v2m
c:tempziptempdocuments.zip " & repertoire & "*.*"
resultat = objShell.Run(tacommande, 1, True) ' ne rendra la main
qu'une
fois terminé
If resultat = 0 Then
'supprime les pieces jointes
Do While objAtts.Count > nb_embedded ' Boucle interne.
For Each truc In objAtts
typeatt = Attachtype(strEntryID, truc.index)
If typeatt = "" And UCase(Right(truc.FileName, 3)) <>
"ZIP" Then objAtts.Remove (truc.index)
Exit For ' Quitte la boucle interne.
End If
Next truc
Loop
'méthode pour tout supprimer.
'While objAtts.Count > 0
'objAtts.Remove 1
'Wend
objAtts.Add Source:="c:tempziptemp" & ExistDoc,
Type:=olByValue liste = "[Contenu de " & ExistDoc & " : " &
nb_attach - nb_embedded & "
document(s) :<br>" & liste & "]<br>"
If objAtts.Parent.BodyFormat = olFormatHTML Then
objAtts.Parent.HTMLBody = "<HTML>" & liste & "<br>" &
objCurrentMessage.HTMLBody
Else: objCurrentMessage.Body = Replace(liste, "<br>", vbCr) &
objCurrentMessage.Body
End If
'supprimes mes fichiers temporaires
On Error Resume Next
Kill repertoire & "*.*"
Set objShell = Nothing
Else: erreur = "erreur de compression " & vbCr & "Merci de le
signaler à
Olivier"
End If
End If
fin:
On Error Resume Next
If erreur <> "" Then
MsgBox erreur, vbCritical, "Fin de traitement"
Else
'MsgBox "Traitement terminé"
End If
Attente.Label2 = "Terminé"
Attente.Repaint
Unload Attente
Set resultat = Nothing
Set erreur = Nothing
Set objCurrentMessage = Nothing
Set objAtts = Nothing
Set nb_attach = Nothing
Set tacommande = Nothing
Set liste = Nothing
End Sub
' Function: Fields_Selector
' Purpose: View type of attachment
' olivier catteau fevrier 2006
Function Attachtype(ByVal strEntryID As String, attindex As
Integer) As Variant
Dim oSession As MAPI.Session
' CDO objects
Dim oMsg As MAPI.Message
Dim oAttachs As MAPI.Attachments
Bonjour Olivier,
Merci beaucoup pour ce mode d'emploi détaillé.
Il s'avère que dans la référence je n'ai pas la librairie que tu
cite, mais la Microsoft CDO for Windows 2000 library, je l'ai donc
activée.
Au final, un clic sur le bouton créé ne donne strictement aucun
action, ni aucune erreur.
Pour mémoire, j'utilise Outlook 2000.
A plus tard.
David
"David" <David@discussions.microsoft.com> a écrit dans le message de
news: DF246063-71E6-4532-A45F-CD1E208AFAD5@microsoft.com...
Tous mes remerciements Olivier !
Cependant, au risque de paraitre ennuyeux, il s'avère que je ne
sais pas du
tout que faire avec ces éléments que tu viens de me communiquer,
étant, pour
ainsi dire, une sorte "d'utilisateur final".
tu sais je suis quasiment autodidacte, on peut toujours apprendre à
faire!! mais bon c'est gratuit donc faut mettre la main à la patte.
Faut donc installer 7-ZIP.
Puis dans outlook tu appuyes sur alt+F11. ca ouvre le gestionnaire
de macro VBE.
tu cliques dans le menu sur insertion / module
si tu fais un copier coller ci-dessous de "sub zip" à "End
Function",
tu auras des erreurs à cause du retour à ligne après 76 caractères
(les lignes en rouge) en plus faut supprimer les ">>"
alors rècupère le code sur
http://212.11.50.28/~olivier/sub_zip.bas
et
http://212.11.50.28/~olivier/Fonctions%20type%20attachment.bas
que tu mets à la suite dans le module
[il manquait un bout de code que j'ai mis dans le deuxième lien.
Sub GetSelectedItems()
Dim myOlApp As New Outlook.Application
Dim myOlExp As Outlook.Explorer
Dim myOlSel As Outlook.Selection
Dim MsgTxt As String
Dim x As Integer
MsgTxt = "Vous devez selectionner un seul mail"
Set myOlExp = myOlApp.ActiveExplorer
Set myOlSel = myOlExp.Selection
x = myOlSel.Count
If x <> 1 Then
MsgBox MsgTxt
Exit Sub
End If
myOlSel.Item(x).Display
End Sub]
Il faut ajouter une référence à "Microsoft CDO 1.21 LIBRARY" en
cochant la case dans outils références.
tu fermes cette fenêtre puis
dans OUTLOOK / macro/securite
tu coches "niveau Moyen".
Tu ouvres un mail .
Tu cliques bouton droit sur la barre des icones / personnaliser
DAns catégorie tu te positionnes sur macros et à droite tu vas voir
PROJET1.zip
tu le prends avec ta souris et tu le poses dans la barre des icones.
tu fermes toutes les fenetres outlook. et réponds OUI à [Voulez-vous
enregistrer le projet VBA 'ThisOutlooksession']
tu réouvres OUTLOOK .
tu ouvres ou tu créés le mail dont tu veux zipper les pièces jointes
tu cliquez sur l'icone "zip" créé
au "security warning" tu cliques "activer les macros"
Et voilà !!!!
je pense ne rien avoir oublié.
--
--
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Have a nice day
Oliv'
Pour me joindre : http://cerbermail.com/?V8r2o1YHl4
les sites références:
Excel :http://www.excelabo.net http://xcell05.free.fr/
http://dj.joss.free.fr/
http://frederic.sigonneau.free.fr/ http://www.excel-vba-francais.com/
Word : http://faqword.free.fr/
Outlook :http://faq.outlook.free.fr/
Sql :http://sqlpro.developpez.com/
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
En espérant ne pas trop abuser de ton temps,
David
Bonjour,
Notre entreprise tourne sous Outlook 2000 et dans le cadre de
notre activité nous recevons de très nombreux mails contenant des
pièces jointes par jours.
Je recherche un moyen de sauvegarder les pièces jointes d'un mail
particulier au sein d'un seul et même fichier d'archives ZIP. Par
exemple par le biais d'un add-on qui afficherait sur l'interface
de lecture du mail un bouton dédié à cet effet.
J'avais trouvé sur le net "Outlook Attachment Sniffer" mais ce
logiciel, bien que très complet, n'offre pas la fonction que je
recherche. En effet, il gère le traitement par lot des mails, et
pas la gestion au cas par cas.
Je vous en remercie par avance.
je viens d'écrire un truc dans ce genre pour outlook 2003 avec
lancement par
un icone
avec notamment l'aide de sources de Sue Mosher et de son excellent
site http://www.outlookcode.com/ et de bastanu sur www.vbforums.com
..
il faut 7zip sur www.7-zip.org
un formulaire nommé "attente" pour faire patienter ou mettre un '
devant les
lignes concernées.
un repertoire "c:temp"
confirmer à la fermeture l'enregistrement
ca marche sur les nouveau mail et les mails déjà recus ou envoyés.
Pour parfaire le tout tu peux ajouter cette macro avec un test
sur la taille du mail dans l'evenement application_itemsend .
La fonction Attachtype a également des utilisations très
interessantes pour
différencier les images insérées au sein des pièces jointes.
Voici donc ma contribution !!!
MERCI DE ME FAIRE REMONTER SON UTILISATION ET SES BUG EVENTUELS
' zip les pieces jointes du mail
Sub ZIP()
' création OLIVIER CATTEAU 2006
On Error Resume Next
Load Attente
Attente.Label2 = "ETAPE 1/3"
Dim liste
'parcours des fichiers attachés
################################################################################
Dim objAtt As Attachment, objAtts As Attachments,
objCurrentMessage As
MailItem
If Application.ActiveInspector Is Nothing Then GetSelectedItems
Set objCurrentMessage = ActiveInspector.CurrentItem
Set objAtts = objCurrentMessage.Attachments
nb_attach = objAtts.Count
If nb_attach = 0 Then
erreur = "Pas de fichiers joints"
GoTo fin
End If
Attente.Show vbModeless
On Error GoTo 0
'on crée le repertoire où mettre les fichiers joints
##########################################################
repertoire = "c:tempziptemp" & ""
If repertoire <> "" Then
If "" = Dir(repertoire, vbDirectory) Then
MkDir repertoire
Else
On Error Resume Next
Kill repertoire & "*.*"
On Error GoTo 0
End If
End If
'#################################Traitement des fichiers
joints ###################################################
'liste = ""
Dim strEntryID As String
If objCurrentMessage.EntryID = "" Then objCurrentMessage.Save
strEntryID = objCurrentMessage.EntryID
For Each objAtt In objAtts
typeatt = Attachtype(strEntryID, objAtt.index)
If typeatt <> "" Or UCase(Right(objAtt.FileName, 3)) >>>> "ZIP" Then MsgBox " [" & objAtt.FileName & "] est une
image insérée ou est
déjà
un ZIP" & vbCr & " cette pièce ne sera pas zippée"
nb_embedded = nb_embedded + 1
Else
'ajoutter un controle dir sur le fichier et mettre l'index
devant le
nom pour les doublons
objAtt.SaveAsFile repertoire & Replace(objAtt.FileName,
"?", "euro")
liste = liste & "{" & objAtt.FileName & "}"
End If
Next
' zippe les documents
If nb_attach > nb_embedded Then
Dim objShell As Object
Set objShell = CreateObject("WScript.Shell")
On Error Resume Next
ExistDoc = nb_attach - nb_embedded & "documents.zip"
If ExistDoc <> objAtts(ExistDoc) Then
ExistDoc = nb_attach - nb_embedded & "documents.zip"
Else
ExistDoc = "documents.zip"
End If
On Error GoTo 0
tacommande = """C:Program Files7-Zip7za"" a -tzip
c:tempziptemp" &
ExistDoc & " " & repertoire & "*.*"
' pour volume multiple si + 2 mo
'TaCommande = """C:Program Files7-Zip7za"" a -tzip -v2m
c:tempziptempdocuments.zip " & repertoire & "*.*"
resultat = objShell.Run(tacommande, 1, True) ' ne rendra la main
qu'une
fois terminé
If resultat = 0 Then
'supprime les pieces jointes
Do While objAtts.Count > nb_embedded ' Boucle interne.
For Each truc In objAtts
typeatt = Attachtype(strEntryID, truc.index)
If typeatt = "" And UCase(Right(truc.FileName, 3)) <>
"ZIP" Then objAtts.Remove (truc.index)
Exit For ' Quitte la boucle interne.
End If
Next truc
Loop
'méthode pour tout supprimer.
'While objAtts.Count > 0
'objAtts.Remove 1
'Wend
objAtts.Add Source:="c:tempziptemp" & ExistDoc,
Type:=olByValue liste = "[Contenu de " & ExistDoc & " : " &
nb_attach - nb_embedded & "
document(s) :<br>" & liste & "]<br>"
If objAtts.Parent.BodyFormat = olFormatHTML Then
objAtts.Parent.HTMLBody = "<HTML>" & liste & "<br>" &
objCurrentMessage.HTMLBody
Else: objCurrentMessage.Body = Replace(liste, "<br>", vbCr) &
objCurrentMessage.Body
End If
'supprimes mes fichiers temporaires
On Error Resume Next
Kill repertoire & "*.*"
Set objShell = Nothing
Else: erreur = "erreur de compression " & vbCr & "Merci de le
signaler à
Olivier"
End If
End If
fin:
On Error Resume Next
If erreur <> "" Then
MsgBox erreur, vbCritical, "Fin de traitement"
Else
'MsgBox "Traitement terminé"
End If
Attente.Label2 = "Terminé"
Attente.Repaint
Unload Attente
Set resultat = Nothing
Set erreur = Nothing
Set objCurrentMessage = Nothing
Set objAtts = Nothing
Set nb_attach = Nothing
Set tacommande = Nothing
Set liste = Nothing
End Sub
' Function: Fields_Selector
' Purpose: View type of attachment
' olivier catteau fevrier 2006
Function Attachtype(ByVal strEntryID As String, attindex As
Integer) As Variant
Dim oSession As MAPI.Session
' CDO objects
Dim oMsg As MAPI.Message
Dim oAttachs As MAPI.Attachments
Bonjour Olivier,
Merci beaucoup pour ce mode d'emploi détaillé.
Il s'avère que dans la référence je n'ai pas la librairie que tu
cite, mais la Microsoft CDO for Windows 2000 library, je l'ai donc
activée.
Au final, un clic sur le bouton créé ne donne strictement aucun
action, ni aucune erreur.
Pour mémoire, j'utilise Outlook 2000.
A plus tard.
David
"David" a écrit dans le message de
news:Tous mes remerciements Olivier !
Cependant, au risque de paraitre ennuyeux, il s'avère que je ne
sais pas du
tout que faire avec ces éléments que tu viens de me communiquer,
étant, pour
ainsi dire, une sorte "d'utilisateur final".
tu sais je suis quasiment autodidacte, on peut toujours apprendre à
faire!! mais bon c'est gratuit donc faut mettre la main à la patte.
Faut donc installer 7-ZIP.
Puis dans outlook tu appuyes sur alt+F11. ca ouvre le gestionnaire
de macro VBE.
tu cliques dans le menu sur insertion / module
si tu fais un copier coller ci-dessous de "sub zip" à "End
Function",
tu auras des erreurs à cause du retour à ligne après 76 caractères
(les lignes en rouge) en plus faut supprimer les ">>"
alors rècupère le code sur
http://212.11.50.28/~olivier/sub_zip.bas
et
http://212.11.50.28/~olivier/Fonctions%20type%20attachment.bas
que tu mets à la suite dans le module
[il manquait un bout de code que j'ai mis dans le deuxième lien.
Sub GetSelectedItems()
Dim myOlApp As New Outlook.Application
Dim myOlExp As Outlook.Explorer
Dim myOlSel As Outlook.Selection
Dim MsgTxt As String
Dim x As Integer
MsgTxt = "Vous devez selectionner un seul mail"
Set myOlExp = myOlApp.ActiveExplorer
Set myOlSel = myOlExp.Selection
x = myOlSel.Count
If x <> 1 Then
MsgBox MsgTxt
Exit Sub
End If
myOlSel.Item(x).Display
End Sub]
Il faut ajouter une référence à "Microsoft CDO 1.21 LIBRARY" en
cochant la case dans outils références.
tu fermes cette fenêtre puis
dans OUTLOOK / macro/securite
tu coches "niveau Moyen".
Tu ouvres un mail .
Tu cliques bouton droit sur la barre des icones / personnaliser
DAns catégorie tu te positionnes sur macros et à droite tu vas voir
PROJET1.zip
tu le prends avec ta souris et tu le poses dans la barre des icones.
tu fermes toutes les fenetres outlook. et réponds OUI à [Voulez-vous
enregistrer le projet VBA 'ThisOutlooksession']
tu réouvres OUTLOOK .
tu ouvres ou tu créés le mail dont tu veux zipper les pièces jointes
tu cliquez sur l'icone "zip" créé
au "security warning" tu cliques "activer les macros"
Et voilà !!!!
je pense ne rien avoir oublié.
--
--
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Have a nice day
Oliv'
Pour me joindre : http://cerbermail.com/?V8r2o1YHl4
les sites références:
Excel :http://www.excelabo.net http://xcell05.free.fr/
http://dj.joss.free.fr/
http://frederic.sigonneau.free.fr/ http://www.excel-vba-francais.com/
Word : http://faqword.free.fr/
Outlook :http://faq.outlook.free.fr/
Sql :http://sqlpro.developpez.com/
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~En espérant ne pas trop abuser de ton temps,
DavidBonjour,
Notre entreprise tourne sous Outlook 2000 et dans le cadre de
notre activité nous recevons de très nombreux mails contenant des
pièces jointes par jours.
Je recherche un moyen de sauvegarder les pièces jointes d'un mail
particulier au sein d'un seul et même fichier d'archives ZIP. Par
exemple par le biais d'un add-on qui afficherait sur l'interface
de lecture du mail un bouton dédié à cet effet.
J'avais trouvé sur le net "Outlook Attachment Sniffer" mais ce
logiciel, bien que très complet, n'offre pas la fonction que je
recherche. En effet, il gère le traitement par lot des mails, et
pas la gestion au cas par cas.
Je vous en remercie par avance.
je viens d'écrire un truc dans ce genre pour outlook 2003 avec
lancement par
un icone
avec notamment l'aide de sources de Sue Mosher et de son excellent
site http://www.outlookcode.com/ et de bastanu sur www.vbforums.com
..
il faut 7zip sur www.7-zip.org
un formulaire nommé "attente" pour faire patienter ou mettre un '
devant les
lignes concernées.
un repertoire "c:temp"
confirmer à la fermeture l'enregistrement
ca marche sur les nouveau mail et les mails déjà recus ou envoyés.
Pour parfaire le tout tu peux ajouter cette macro avec un test
sur la taille du mail dans l'evenement application_itemsend .
La fonction Attachtype a également des utilisations très
interessantes pour
différencier les images insérées au sein des pièces jointes.
Voici donc ma contribution !!!
MERCI DE ME FAIRE REMONTER SON UTILISATION ET SES BUG EVENTUELS
' zip les pieces jointes du mail
Sub ZIP()
' création OLIVIER CATTEAU 2006
On Error Resume Next
Load Attente
Attente.Label2 = "ETAPE 1/3"
Dim liste
'parcours des fichiers attachés
################################################################################
Dim objAtt As Attachment, objAtts As Attachments,
objCurrentMessage As
MailItem
If Application.ActiveInspector Is Nothing Then GetSelectedItems
Set objCurrentMessage = ActiveInspector.CurrentItem
Set objAtts = objCurrentMessage.Attachments
nb_attach = objAtts.Count
If nb_attach = 0 Then
erreur = "Pas de fichiers joints"
GoTo fin
End If
Attente.Show vbModeless
On Error GoTo 0
'on crée le repertoire où mettre les fichiers joints
##########################################################
repertoire = "c:tempziptemp" & ""
If repertoire <> "" Then
If "" = Dir(repertoire, vbDirectory) Then
MkDir repertoire
Else
On Error Resume Next
Kill repertoire & "*.*"
On Error GoTo 0
End If
End If
'#################################Traitement des fichiers
joints ###################################################
'liste = ""
Dim strEntryID As String
If objCurrentMessage.EntryID = "" Then objCurrentMessage.Save
strEntryID = objCurrentMessage.EntryID
For Each objAtt In objAtts
typeatt = Attachtype(strEntryID, objAtt.index)
If typeatt <> "" Or UCase(Right(objAtt.FileName, 3)) >>>> "ZIP" Then MsgBox " [" & objAtt.FileName & "] est une
image insérée ou est
déjà
un ZIP" & vbCr & " cette pièce ne sera pas zippée"
nb_embedded = nb_embedded + 1
Else
'ajoutter un controle dir sur le fichier et mettre l'index
devant le
nom pour les doublons
objAtt.SaveAsFile repertoire & Replace(objAtt.FileName,
"?", "euro")
liste = liste & "{" & objAtt.FileName & "}"
End If
Next
' zippe les documents
If nb_attach > nb_embedded Then
Dim objShell As Object
Set objShell = CreateObject("WScript.Shell")
On Error Resume Next
ExistDoc = nb_attach - nb_embedded & "documents.zip"
If ExistDoc <> objAtts(ExistDoc) Then
ExistDoc = nb_attach - nb_embedded & "documents.zip"
Else
ExistDoc = "documents.zip"
End If
On Error GoTo 0
tacommande = """C:Program Files7-Zip7za"" a -tzip
c:tempziptemp" &
ExistDoc & " " & repertoire & "*.*"
' pour volume multiple si + 2 mo
'TaCommande = """C:Program Files7-Zip7za"" a -tzip -v2m
c:tempziptempdocuments.zip " & repertoire & "*.*"
resultat = objShell.Run(tacommande, 1, True) ' ne rendra la main
qu'une
fois terminé
If resultat = 0 Then
'supprime les pieces jointes
Do While objAtts.Count > nb_embedded ' Boucle interne.
For Each truc In objAtts
typeatt = Attachtype(strEntryID, truc.index)
If typeatt = "" And UCase(Right(truc.FileName, 3)) <>
"ZIP" Then objAtts.Remove (truc.index)
Exit For ' Quitte la boucle interne.
End If
Next truc
Loop
'méthode pour tout supprimer.
'While objAtts.Count > 0
'objAtts.Remove 1
'Wend
objAtts.Add Source:="c:tempziptemp" & ExistDoc,
Type:=olByValue liste = "[Contenu de " & ExistDoc & " : " &
nb_attach - nb_embedded & "
document(s) :<br>" & liste & "]<br>"
If objAtts.Parent.BodyFormat = olFormatHTML Then
objAtts.Parent.HTMLBody = "<HTML>" & liste & "<br>" &
objCurrentMessage.HTMLBody
Else: objCurrentMessage.Body = Replace(liste, "<br>", vbCr) &
objCurrentMessage.Body
End If
'supprimes mes fichiers temporaires
On Error Resume Next
Kill repertoire & "*.*"
Set objShell = Nothing
Else: erreur = "erreur de compression " & vbCr & "Merci de le
signaler à
Olivier"
End If
End If
fin:
On Error Resume Next
If erreur <> "" Then
MsgBox erreur, vbCritical, "Fin de traitement"
Else
'MsgBox "Traitement terminé"
End If
Attente.Label2 = "Terminé"
Attente.Repaint
Unload Attente
Set resultat = Nothing
Set erreur = Nothing
Set objCurrentMessage = Nothing
Set objAtts = Nothing
Set nb_attach = Nothing
Set tacommande = Nothing
Set liste = Nothing
End Sub
' Function: Fields_Selector
' Purpose: View type of attachment
' olivier catteau fevrier 2006
Function Attachtype(ByVal strEntryID As String, attindex As
Integer) As Variant
Dim oSession As MAPI.Session
' CDO objects
Dim oMsg As MAPI.Message
Dim oAttachs As MAPI.Attachments
Si je peux me permettre, n'est il pas possible d'utiliser la fonction
de compression de Windows afin de rendre ce prog parfaitement intégré
?
Si je peux me permettre, n'est il pas possible d'utiliser la fonction
de compression de Windows afin de rendre ce prog parfaitement intégré
?
Si je peux me permettre, n'est il pas possible d'utiliser la fonction
de compression de Windows afin de rendre ce prog parfaitement intégré
?
