Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

Macro - Filtre sur pièces jointes à extensions de type virus

2 réponses
Avatar
Miki
Bonjour,

Je souhaiterais faire (ou reprendre un code source existant) d'une
macro qui filtre les messages à leur arrivée dans la boite de
réception en fonction des extensions de pièces jointes de type .scr,
.pif, .bat etc...
Pourriez vous m'aider ou me communiquer un site qui me donne les
bonnes infos.

Je vous en remercie par avance ;o)

2 réponses

Avatar
Marc VANSTEELANT
Salut,

Tout d'abord tout dépend ta version de outlook, car seule la 2003 est
capable de lancer une macro comme une règle de messagerie...et donc faire ce
que tu veux à l'arrivé de ton message.
Sinon moi j'ai récupéré un bout de code que j'ai modifié pour sauvegarder ma
piece jointe dans un dossier Windows, mais d'après ce code tu dois pouvoir
faire ce que tu veux...Tu verras moi j'utilise cette macro sur des mail
possedant qu'un seul fichier joint et j'ai donc mis en commentaire les
boucles vérifiant si tu en a plus d'un.

Le code initial provient de Sue Mosher, de son site
http://www.outlookcode.com/jumpstart.aspx

Bon courage...

Marc.


Sub SaveAttachment()

'Declaration
Dim myItems, myItem, myAttachments, myAttachment As Object
Dim myOrt As String
Dim myOlApp As New Outlook.Application
Dim myOlExp As Outlook.Explorer
Dim myOlSel As Outlook.Selection

'chemin où copier les fichiers joints
myOrt = "BurCommunsCONTROLEControle - TClientsALST CHEWB
libérésMP"

On Error Resume Next

'work on selected items
Set myOlExp = myOlApp.ActiveExplorer
Set myOlSel = myOlExp.Selection

'for all items do...
For Each myItem In myOlSel

'point on attachments
Set myAttachments = myItem.Attachments

'if there are some...
If myAttachments.Count > 0 Then

'for all attachments do...
For i = 1 To myAttachments.Count
'save them to destination
myAttachments(i).SaveAsFile myOrt &
myAttachments(i).DisplayName

'add name and destination to message text
myItem.Body = myItem.Body & "Fichier copié : " & myOrt &
myAttachments(i).DisplayName & vbCrLf
Next i

'save item without attachments
myItem.Save
End If

Next

'free variables
Set myItems = Nothing
Set myItem = Nothing
Set myAttachments = Nothing
Set myAttachment = Nothing
Set myOlApp = Nothing
Set myOlExp = Nothing
Set myOlSel = Nothing
msg = MsgBox("Sauvegarde des pièces jointes terminée...", vbOKOnly,
"Information")
End Sub



"Miki" a écrit dans le message de
news:
Bonjour,

Je souhaiterais faire (ou reprendre un code source existant) d'une
macro qui filtre les messages à leur arrivée dans la boite de
réception en fonction des extensions de pièces jointes de type .scr,
.pif, .bat etc...
Pourriez vous m'aider ou me communiquer un site qui me donne les
bonnes infos.

Je vous en remercie par avance ;o)


Avatar
Miki
Je te remercie ! Je vais tester ça de suite


On Wed, 7 Apr 2004 07:51:50 +0200, "Marc VANSTEELANT"
wrote:

Salut,

Tout d'abord tout dépend ta version de outlook, car seule la 2003 est
capable de lancer une macro comme une règle de messagerie...et donc faire ce
que tu veux à l'arrivé de ton message.
Sinon moi j'ai récupéré un bout de code que j'ai modifié pour sauvegarder ma
piece jointe dans un dossier Windows, mais d'après ce code tu dois pouvoir
faire ce que tu veux...Tu verras moi j'utilise cette macro sur des mail
possedant qu'un seul fichier joint et j'ai donc mis en commentaire les
boucles vérifiant si tu en a plus d'un.

Le code initial provient de Sue Mosher, de son site
http://www.outlookcode.com/jumpstart.aspx

Bon courage...

Marc.


Sub SaveAttachment()

'Declaration
Dim myItems, myItem, myAttachments, myAttachment As Object
Dim myOrt As String
Dim myOlApp As New Outlook.Application
Dim myOlExp As Outlook.Explorer
Dim myOlSel As Outlook.Selection

'chemin où copier les fichiers joints
myOrt = "BurCommunsCONTROLEControle - TClientsALST CHEWB
libérésMP"

On Error Resume Next

'work on selected items
Set myOlExp = myOlApp.ActiveExplorer
Set myOlSel = myOlExp.Selection

'for all items do...
For Each myItem In myOlSel

'point on attachments
Set myAttachments = myItem.Attachments

'if there are some...
If myAttachments.Count > 0 Then

'for all attachments do...
For i = 1 To myAttachments.Count
'save them to destination
myAttachments(i).SaveAsFile myOrt &
myAttachments(i).DisplayName

'add name and destination to message text
myItem.Body = myItem.Body & "Fichier copié : " & myOrt &
myAttachments(i).DisplayName & vbCrLf
Next i

'save item without attachments
myItem.Save
End If

Next

'free variables
Set myItems = Nothing
Set myItem = Nothing
Set myAttachments = Nothing
Set myAttachment = Nothing
Set myOlApp = Nothing
Set myOlExp = Nothing
Set myOlSel = Nothing
msg = MsgBox("Sauvegarde des pièces jointes terminée...", vbOKOnly,
"Information")
End Sub



"Miki" a écrit dans le message de
news:
Bonjour,

Je souhaiterais faire (ou reprendre un code source existant) d'une
macro qui filtre les messages à leur arrivée dans la boite de
réception en fonction des extensions de pièces jointes de type .scr,
.pif, .bat etc...
Pourriez vous m'aider ou me communiquer un site qui me donne les
bonnes infos.

Je vous en remercie par avance ;o)