Macro vb pour ms outlook yassine ettarchegue

Soyez le premier à donner votre avis sur cette source.

Snippet vu 55 766 fois - Téléchargée 36 fois

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

Ajouter un commentaire Commentaires
Messages postés
1
Date d'inscription
samedi 7 janvier 2006
Statut
Membre
Dernière intervention
9 janvier 2006

Bonjour,
quelqu'un peut-il me donner un tuyau concernant une macro que j'aimerai réaliser pour:
- ouvrir 1 par 1 tous les fichiers txt d'un dossier (dossier outlook ou dossier de l'explorer)
- faire un email avec chacun d'entre eux en copiant la ligne contenant OBJET et en la mettant en sujet, en mettant tout le texte dans le corps du message

voici ce que j'ai écri mais ça ne fonctionne pas

Sub msg()

'Procedure de traitement des messages
Dim folder As String
Dim MonMsg As Outlook.MailItem
Dim Myitem As Object
Dim MsgTxt As String
Dim txt As String
Dim myFolder As Outlook.MAPIFolder
Dim fs, f


Set myOlApp = CreateObject("Outlook.Application")
Set myNameSpace = myOlApp.GetNamespace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(olFolderDrafts)


If myFolder.Items.Count = 0 Then 'si le dossier Draft est vide, il n'y a pas de msg à envoyer
MsgBox ("Pas de message dans le dossier Draft")
Exit Sub
Else
For i = 1 To myFolder.Items.Count 'pour tous les messages dans le dossier Draft

' Ouvrir le fichier attaché
Const ForReading 1, ForWriting 2, ForAppending = 3
Const TristateUseDefault -2, TristateTrue -1, TristateFalse = 0
Set f = fs.GetFile(myFolder.Items(i))
Set Myitem = f.OpenAsTextStream(ForWriting, TristateUseDefault)


' faire un copier de l'ensemble du texte appelé MsgTxt
myItem.Select.all
Selection.Copy

' faire nouveau message appelé "MonMsg"
Set MonMsg = olApp.CreateItem(olMailItem)


' coller le texte
MonMsg.Body = txt

' chercher le mot OBJET

' copier la ligne le contenant

' coller le texte dans SUBJECT
MonMsg.Subject = " test "

' mettre le destinataire toto
MonMsg.To = "toto@tata.tutu"

' envoyer
MonMsg.Send
Next

' effacer tous les messages dans le répertoire Draft

For i = 1 To myFolder.Items.Count
Set Myitem = myFolder.Items(1)
Myitem.Delete
Next
End If
End Sub

merci de votre aide
Messages postés
2
Date d'inscription
lundi 5 mai 2003
Statut
Membre
Dernière intervention
14 janvier 2004

bonjour, merci pour ton code en VBA qui nous permet de visiter la Tunisie!
As-tu une idée pour accéder directement au Folder "Dossiers Personnels"? je n'arrive pas avec :
Set myfolder = myNameSpace.GetDefaultFolder("Dossiers Personnels")
Messages postés
6
Date d'inscription
vendredi 1 août 2003
Statut
Membre
Dernière intervention
18 septembre 2003

Il s'agit ici d'un VBA, j'aimerais pouvoir faire la même chose en VB6, plus exactement enregistrer tous les mails en fichier txt mais pas ceux de la boite de reception mais d'un dossier de la boite aux lettres. Comment réussir à pointer dans un dossier de la bal ?
Messages postés
6
Date d'inscription
vendredi 1 août 2003
Statut
Membre
Dernière intervention
18 septembre 2003

Il s'agit ici d'un VBA, j'aimerais pouvoir faire la même chose en VB6, plus exactement enregistrer tous les mails en fichier txt mais pas ceux de la boite de reception mais d'un dossier de la boite aux lettres. Comment réussir à pointer dans un dossier de la bal ?
Messages postés
94
Date d'inscription
dimanche 29 septembre 2002
Statut
Membre
Dernière intervention
26 août 2009

Bonjour,

2 petites choses,
La premiere, ton source fait appel a un userform1 qui n'est pas dans le source.
Il semble que tu soit en mesure d'enregistrer la piece jointe dans un repertoire mais tu ne le fais pas.
Pour continuer dans les remarques, il est vrai qu'un source zippé est bien meme si c'est un fichier excel, attention quand meme a ne pas mettre de mot de passe...

c'est tres bien quand même

Pour info OLLIVIER, olfolderinbox est Ol ==> Outlook, Folder ==> Dossier, Inbox ==> Reception.
Peut être n'a tu pas réfarencé Outlook dans ton projet !!

A bientôt
Seb Of_Borg
Afficher les 8 commentaires

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.