1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75
|
Sub locking()
Dim NS As Outlook.NameSpace
Dim test As Outlook.Account
Dim Dossier As Outlook.MAPIFolder
Dim Filter As String
Dim xl As Excel.Application
Set xlapp = New Excel.Application
xlapp.DisplayAlerts = False
xlapp.ScreenUpdating = True
xlapp.Visible = True
xlapp.Workbooks.Add
'Application.DisplayAlerts = False
Set NS = ThisOutlookSession.GetNamespace("MAPI")
Set Dossier = NS.Folders("xxx@xxxx.fr").Folders("Boîte de réception")
Set colItems = Dossier.Items
Set colFilteredItems = colItems.Restrict("[ReceivedTime] > '08/6/2013 00:00 AM'")
colFilteredItems.Sort ("[ReceivedTime]")
Set myDestFolder = NS.Folders("xxx@xxxx.fr").Folders("Test")
nbref = colFilteredItems.Count
correction = 0
Z = 1
For i = nbref To 1 Step -1
Set objMessage = colFilteredItems.Item(i)
xlapp.Cells(Z, 1).Value = objMessage.Subject
xlapp.Cells(Z, 2).Value = objMessage.ReceivedTime
xlapp.Cells(Z, 3).Value = objMessage.SenderName
xlapp.Cells(Z, 4).Value = objMessage.SenderEmailAddress
xlapp.Cells(Z, 5).Value = objMessage.AutoForwarded
xlapp.Cells(Z, 6).Value = objMessage.SentOn
'indicateur de suivi
xlapp.Cells(Z, 7).Value = objMessage.FlagRequest
'catégorie
xlapp.Cells(Z, 8).Value = objMessage.Categories
'Date de fin souhaitée
'xlapp.Cells(i, 11).Value = objMessage.TaskStartDate
'heure de flag
'xlapp.Cells(i, 12).Value = objMessage.TaskDueDate
xlapp.Cells(Z, 9).Value = objMessage.LastModificationTime
xlapp.Cells(Z, 10).Value = objMessage.FlagStatus
If objMessage.FlagStatus = 1 Then
xlapp.Cells(Z, 11).Value = objMessage.TaskCompletedDate
xlapp.Cells(Z, 12).Value = objMessage.ItemProperties.Item(17)
xlapp.Cells(Z, 12).Value = objMessage.ToDoTaskOrdinal
' If objMessage.UnRead = False Then
' objMessage.Move myDestFolder
End If
Z = Z + 1
Next i
End Sub |
Partager