J'essaie de télécharger les pièces jointes de messagerie dans la boîte de réception Outlook en fonction de la date reçue. Mes téléchargements de code des pièces jointes, mais il ignore les fichiers.
Par exemple: J'essayais de boucler le courrier électronique du dernier courrier électronique (date reçue: 01/14/2019). Après avoir bouclé vers 10-15 courriels, il saute soudainement pour lire le courrier électronique reçu le 12/07/2018. P>
Sub saveemailattachment()
'Application setup
Dim objOL As Outlook.Application
Set objOL = New Outlook.Application
Dim ONS As Outlook.Namespace
Set ONS = objOL.GetNamespace("MAPI")
Dim olfolder As Outlook.Folder
Set olfolder = ONS.GetDefaultFolder(olFolderInbox)
Dim olmail As Outlook.MailItem
Set olmail = objOL.CreateItem(olMailItem)
Dim olattachment As Outlook.Attachment
Dim i As Long
Dim filename As String
Dim VAR As Date
'Loop through all item in Inbox
For i = olfolder.Items.Count To 1 Step -1 'Iterates from the end backwards
Set olmail = olfolder.Items(i)
For Each olmail In olfolder
VAR = Format(olmail.ReceivedTime, "MM/DD/YYYY")
filename = olmail.Subject
If VAR = "1/14/2019" Then
For Each olattachment In olmail.Attachments
olattachment.SaveAsFile "C:\Users\Rui_Gaalh\Desktop\Email attachment\" & olattachment.filename
Next
Else
End If
'Mark email as read
olmail.UnRead = False
DoEvents
olmail.Save
Next
Next
MsgBox "DONE"
End Sub
3 Réponses :
si vous essayez simplement de sauvegarder des pièces jointes reçues sur "1/14/2019", pas besoin de em>
Option Explicit
Sub saveemailattachment()
'Application setup
Dim objOL As Outlook.Application
Set objOL = New Outlook.Application
Dim ONS As Outlook.NameSpace
Set ONS = objOL.GetNamespace("MAPI")
Dim olfolder As Outlook.Folder
Set olfolder = ONS.GetDefaultFolder(olFolderInbox)
Dim olmail As Object
Dim olattachment As Outlook.attachment
Dim i As Long
Dim filename As String
Dim VAR As Date
'Loop through all item in Inbox
For i = olfolder.items.Count To 1 Step -1 'Iterates from the end backwards
DoEvents
Set olmail = olfolder.items(i)
If TypeOf olmail Is Outlook.MailItem Then
VAR = Format(olmail.ReceivedTime, "MM/DD/YYYY")
filename = olmail.Subject
If VAR = "1/14/2019" Then
For Each olattachment In olmail.Attachments
olattachment.SaveAsFile _
"C:\Users\Rui_Gaalh\Desktop\Email attachment\" _
& olattachment.filename
Next
'Mark email as read
olmail.UnRead = False
End If
End If
Next
MsgBox "DONE"
End Sub
Ne pas boucler à travers tous les éléments d'un dossier - certains dossiers peuvent avoir dix des milliers de messages. Utilisez En cas de items.find / FindNext ou éléments.Restrict avec une requête comme "[reçu]> = '2019-01-14' et [reçu Time] <' 2019-01-15 '".
items.find / FindNext , vous n'aurez pas de problème avec des emails sautés. En cas de items.Restrict , utilisez une boucle de descente de compter jusqu'à 1 étape -1.
Merci pour toutes vos suggestions. Le code fonctionne parfaitement. Veuillez trouver le code final ci-dessous:
Option Explicit
Sub saveemailattachment()
'Application setup
Dim objOL As Outlook.Application
Set objOL = New Outlook.Application
Dim ONS As Outlook.Namespace
Set ONS = objOL.GetNamespace("MAPI")
Dim olfolder As Outlook.Folder
Set olfolder = ONS.GetDefaultFolder(olFolderInbox)
Dim olmail As Object
Dim olattachment As Outlook.Attachment
Dim i As Long
Dim InboxMsg As Object
Dim filename As String
'Set variables
Dim Sunday As Date
Dim Monday As Date
Dim Savefolder As String
Dim VAR As Date
Dim Timestamp As String
Monday = ThisWorkbook.Worksheets(1).Range("B2")
Sunday = ThisWorkbook.Worksheets(1).Range("B3")
Savefolder = ThisWorkbook.Worksheets(1).Range("B4")
'Loop through all item in Inbox
For i = olfolder.Items.Count To 1 Step -1 'Iterates from the end backwards
DoEvents
Set olmail = olfolder.Items(i)
Application.Wait (Now + TimeValue("0:00:01"))
'Check if olmail is emailitem
If TypeOf olmail Is Outlook.MailItem Then
'Set time fram
VAR = olmail.ReceivedTime 'Set Received time
Timestamp = Format(olmail.ReceivedTime, "YYYY-MM-DD-hhmmss") 'Set timestamp format
If VAR <= Sunday And VAR >= Monday Then
For Each olattachment In olmail.Attachments
Application.Wait (Now + TimeValue("0:00:01"))
'Download excel file and non-L10 file only
If (Right(olattachment.filename, 4) = "xlsx" Or Right(olattachment.filename, 3) = "xls")Then
'Set file name
filename = Timestamp & "_" & olattachment.filename
'Download email
olattachment.SaveAsFile Savefolder & "\" & filename
Application.Wait (Now + TimeValue("0:00:02"))
End If
Next
Else
End If
'Mark email as read
olmail.UnRead = False
DoEvents
olmail.Save
Else
End If
Next
MsgBox "DONE"
End Sub
Supprimer
pour chaque Olmail dans Olfolder Je ne sais pas pourquoi vous avez là-bas.Je ne comprends pas comment cela trouve des courriels reçus aujourd'hui. Pour un email reçu le 14 janvier 2019,
var = format (OLMail.Receivedtime, "mm / jays / aaaa") définiravar au 01/14/2019 qui n'est pas égal au 1/14/2019. J'aurais quelque chose comme:Date de minuit à la dateMidnight = DATERIAL (Année (Année (Now ()), Mois (maintenant ()), Jour (Maintenant ()))) Ceci Ensembleminuit à l'heure 0:00:00 pour aujourd'hui.olmail.receivedtime> = minuit sera vrai pour tous les emails d'aujourd'hui.Laissez-moi savoir si vous avez toujours des problèmes