Réccuperer la date de réception mail Outlook

Résolu/Fermé
Automag - 15 mai 2014 à 11:34
 Automag - 15 mai 2014 à 11:50
Bonjour,

J'ai un dernier problème. Je souhaite utiliser la date de récéption du mail pour créer mon sous dossier au format "yyyymmdd" mais mon programme beug à la ligne :

madate = Format(olMail.ReceivedTime, "yyyymmdd")

L'erreur est :
Run time error 91
Object variable or with block variable not set

Option Explicit
Option Compare Text


Sub Essai()
Extraction "Perso", "***@***"

End Sub


Sub Extraction(NomDossier As String, Expediteur As String)
Dim olApp As Outlook.Application
Dim olSpace As Outlook.NameSpace
Dim olFolder As Outlook.MAPIFolder
Dim olInbox As Outlook.MAPIFolder
Dim olMail As Outlook.MailItem
Dim pceJointe As Outlook.Attachment
Dim y As Integer, x As Integer
Dim madate
Dim chemin As String

madate = Format(olMail.ReceivedTime, "yyyymmdd")

Set olApp = New Outlook.Application
Set olSpace = olApp.GetNamespace("MAPI")
Set olInbox = olSpace.GetDefaultFolder(olFolderInbox)
Set olFolder = olInbox.Folders(NomDossier)

For Each olMail In olFolder.Items
If olMail.SenderEmailAddress = Expediteur And Not olMail.Attachments.Count = 0 Then
For y = 1 To olMail.Attachments.Count
Set pceJointe = olMail.Attachments(y)
Call RepertoireExiste("E:\Test\" & madate)
chemin = "E:\Test\" & madate & "\"
pceJointe.SaveAsFile chemin & pceJointe
Set pceJointe = Nothing
Next y
End If
Next olMail

End Sub


Function RepertoireExiste(chemin As String) As Boolean

On Error Resume Next

RepertoireExiste = GetAttr(chemin) And vbDirectory

If RepertoireExiste = True Then
Exit Function
Else
MkDir (chemin)
End If

End Function
A voir également:

1 réponse

Solution trouvée :

Option Explicit
Option Compare Text


Sub Essai()
Extraction "Perso", "***@***"

End Sub


Sub Extraction(NomDossier As String, Expediteur As String)
Dim olApp As Outlook.Application
Dim olSpace As Outlook.NameSpace
Dim olFolder As Outlook.MAPIFolder
Dim olInbox As Outlook.MAPIFolder
Dim olMail As Outlook.MailItem
Dim pceJointe As Outlook.Attachment
Dim y As Integer, x As Integer
Dim madate
Dim chemin As String


Set olApp = New Outlook.Application
Set olSpace = olApp.GetNamespace("MAPI")
Set olInbox = olSpace.GetDefaultFolder(olFolderInbox)
Set olFolder = olInbox.Folders(NomDossier)

For Each olMail In olFolder.Items
If olMail.SenderEmailAddress = Expediteur And Not olMail.Attachments.Count = 0 Then
For y = 1 To olMail.Attachments.Count
madate = Format(olMail.ReceivedTime, "yyyymmdd")
Set pceJointe = olMail.Attachments(y)
Call RepertoireExiste("E:\Test\" & madate)
chemin = "E:\Test\" & madate & "\"
pceJointe.SaveAsFile chemin & pceJointe
Set pceJointe = Nothing
Next y
End If
Next olMail

End Sub


Function RepertoireExiste(chemin As String) As Boolean

On Error Resume Next

RepertoireExiste = GetAttr(chemin) And vbDirectory

If RepertoireExiste = True Then
Exit Function
Else
MkDir (chemin)
End If

End Function
0