Macro vb pour ms outlook yassine ettarchegue

Commenter

Contenu du snippet

Ce macro VB permet de gerer la boite de recption de MS outlook, permet de deplacer les messages selon les pieces attache et vous permet d'automatiser la sauvegarde des pieces attchee

Source / Exemple : 


Sub Deleting()
'Procedure du suppression des message de la boite de reception
Set myOlApp = CreateObject("Outlook.Application")
Set myNameSpace = myOlApp.GetNamespace("MAPI")
Set myfolder = myNameSpace.GetDefaultFolder(olFolderInbox)
If myfolder.Items.Count = 0 Then
MsgBox ("le dossier boite de recption est vide")
Else
For i = 1 To myfolder.Items.Count
Set myItem = myfolder.Items(1)
myItem.Delete
Next
End If
End Sub

Sub depot()

'Procedure de traitement des messages
Dim folder As String
Set myOlApp = CreateObject("Outlook.Application")
Set myNameSpace = myOlApp.GetNamespace("MAPI")
Set myfolder = myNameSpace.GetDefaultFolder(olFolderInbox)
If myfolder.Items.Count = 0 Then
MsgBox ("le dossier boite de recption est vide")
Else
For i = 1 To myfolder.Items.Count
Set myItem = myfolder.Items(i)
If myItem.Attachments.Count > 0 Then
Set myAttachments = myItem.Attachments
folder = place(myAttachments.Item(1).DisplayName)
'sauegarde du piece attachee
myAttachments.Item(1).SaveAsFile "C:\Sauvegarde\" & folder & "\" _
& myAttachments.Item(1).DisplayName
Else
Set myNS = myfolder.Folders("Noattach")
End If
'deplacement du message dans les repertoires de MS Outlook 
Set myCopiedItem = myItem.Copy
myCopiedItem.Move myNS
Next
End If
End Sub
Function place(folder1 As String)
'foction permattant de detecter a partir du piece attache le repertoire ou on va 
' stocker les messages 
Select Case folder1
Case "AG01ARJ.ARJ"
place = "Tunis"
Case "AG02ARJ.ARJ"
place = "Sousse"
Case "AG03ARJ.ARJ"
place = "Gafsa"
Case "AG04ARJ.ARJ"
place = "Mednine"
Case "AG05ARJ.ARJ"
place = "Kef"
Case "&VNOMAG.ARJ"
place = "Sfax"
Case "AG07ARJ.ARJ"
place = "Nabeul"
Case "AG08ARJ.ARJ"
place = "Gabes"
Case "AG09ARJ.ARJ"
place = "Monastir"
Case "AG10ARJ.ARJ"
place = "Kairouan"
Case "AG11ARJ.ARJ"
place = "Bizert"
Case "AG12ARJ.ARJ"
place = "Bardo"
Case "AG13ARJ.ARJ"
place = "Benarous"
Case "AG14ARJ.ARJ"
place = "Beja"
Case "AG15ARJ.ARJ"
place = "Kasrine"
Case "AG16ARJ.ARJ"
place = "Sidibouz"
Case "AG17ARJ.ARJ"
place = "kebili"
Case "AG18ARJ.ARJ"
place = "Jendouba"
Case "AG19ARJ.ARJ"
place = "Zaghouan"
Case "AG20ARJ.ARJ"
place = "Siliana"
Case "AG21ARJ.ARJ"
place = "Tozeur"
Case "AG22ARJ.ARJ"
place = "Tataouine"
Case "AG23ARJ.ARJ"
place = "Mahdia"
Case "AG24ARJ.ARJ"
place = "Tunis2"
Case "AG25ARJ.ARJ"
place = "Tunis3"
Case "Sauvegarde.zip"
place = "Depot\Historique"
Case Else
place = "tarch"
End Select
End Function
Sub sauvegarde()
UserForm1.Show
End Sub

Conclusion :


Faite attention l'execution de ce macro sans vider la boite de reception peut cause des dupplication des messages
avant d'executer ce macro veiller cree des repertoires sous outLook et sur le disque portant ces noms

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.