Re : VBA entre Outlook et Excel
Voili voila!
Dis moi!
nb : paramétrer les 2 variables vobjet et Repertoire
Fred
[ Code ]
Sub MailPieceJointeTransfert()
Dim message, Repertoire, NomDeFichierSurDisque, NomDeFichier, Taille, Emetteur, vobjet As String
'paramétrer les 2 variables ci dessous
vobjet = "essai"
' Initialisation du reperetoire de sauvegarde - ne pas oublier l'anti-slash à la fin du repertoire
Repertoire = "D:\bilan\"
On Error GoTo errorhandler
'Création de l'objet Outlook
Set objoutlook = CreateObject("Outlook.application")
'Récupération de l'espace de nom d'outlook
Set olns = objoutlook.GetNamespace("MAPI")
'Récupération du répertoire "boite de réception" par défault
Set fld = olns.GetDefaultFolder(olFolderInbox)
' Initialisation
Compteur = 0
' Sauve les pieces jointes des mails se trouvant dans la boîte de réception.
' Pour adresser un dossier dans la boite de réception on pourrait utiliser :
' fld.Folders("Nom_Du_Dossier").Items
For Each mItem In fld.Items
'si mail du jour avec "objet" recherché...
If mItem.Subject = vobjet And Int(mItem.CreationTime) = Int(Now) Then
For Each att In mItem.Attachments
If att.Type = olByValue Then
Compteur = Compteur + 1
' Nom du fichier modifié pour l'enregistrement. Evite les controles superflus en renommant.
Taille = mItem.Size
Emetteur = mItem.SenderName
NomDeFichier = att.Filename
NomDeFichierSurDisque = NomDeFichier
att.SaveAsFile Repertoire & NomDeFichierSurDisque
' affiche différentes informations :
' att.index = position du fichier dans le message
' att.filename = nom du fichier
' mItem.SenderName = Nom de l'émetteur
' mItem.Subject = Sujet du message
' mItem.Body = Corps du message
' mItem.HTMLBody = affiche le le corps du message en HTML - idéal pour récuperer les signatures !
' mItem.Size = Donne la taille du message
' Message = Message & "Le fichier " & att.FileName & " à été sauvegardé." & Chr(13)
message = message & "Message de " & Emetteur & " - " & NomDeFichier & " à été sauvegardé." & Chr(13)
mItem.UnRead = False
'att.Delete
End If
Next
End If
Next
' Message du nombre de PJ enregisté
If Compteur > 0 Then
'Information.Label1 = "Il y a eu " & Compteur & " fichiers de copiés."
'Information.TextBox1.Enabled = True
'Information.TextBox1 = message
'Information.Show
MsgBox Compteur & " fichiers copié(s) : " & vbLf & message
End If
Exit Sub
errorhandler:
MsgBox Err.Description, , Err.Source
End Sub
[ /Code ]
