oleg_tt
16-09-2016, 13:29
Добрый день!
Вроде простое задание, но есть какая-то хитрость, пока не могу понять какая...
После запуска макроса требуется во всех входящих письмах за последние пять дней внести небольшие изменения.
Почему-то макрос вносит изменения только в то сообщение, на котором в данный момент находится курсор, а не во всех полученных письмах за указанный период...
Private Sub ChangeMSG()
Dim olApp As Outlook.Application
Dim fldr As MAPIFolder
Dim myItem As Object
Dim filt As String
Dim i As Integer
Set olApp = New Outlook.Application
Set fldr = olApp.GetNamespace("MAPI").Folders("Входящие").Folders("Свои")
filt = "([ReceivedTime] >= '" & Format(Now() - 5, "dd.MM.yyyy") & "')"
Set myItem = fldr.Items.Restrict(filt)
If myItem.Count > 0 Then
For i = 1 To myItem.Count
If myItem(i).Subject = "Отчет" Then
myItem(i).Categories = "# Отчет #"
myItem(i).Subject = "#Номер#" & Chr(13) & myItem(i).Subject
myItem(i).Body = "# Номер & " #" & Chr(13) & myItem(i).Body
myItem(i).Save
End If
Next i
End If
Set fldr = Nothing
Set olApp = Nothing
End Sub
Вроде простое задание, но есть какая-то хитрость, пока не могу понять какая...
После запуска макроса требуется во всех входящих письмах за последние пять дней внести небольшие изменения.
Почему-то макрос вносит изменения только в то сообщение, на котором в данный момент находится курсор, а не во всех полученных письмах за указанный период...
Private Sub ChangeMSG()
Dim olApp As Outlook.Application
Dim fldr As MAPIFolder
Dim myItem As Object
Dim filt As String
Dim i As Integer
Set olApp = New Outlook.Application
Set fldr = olApp.GetNamespace("MAPI").Folders("Входящие").Folders("Свои")
filt = "([ReceivedTime] >= '" & Format(Now() - 5, "dd.MM.yyyy") & "')"
Set myItem = fldr.Items.Restrict(filt)
If myItem.Count > 0 Then
For i = 1 To myItem.Count
If myItem(i).Subject = "Отчет" Then
myItem(i).Categories = "# Отчет #"
myItem(i).Subject = "#Номер#" & Chr(13) & myItem(i).Subject
myItem(i).Body = "# Номер & " #" & Chr(13) & myItem(i).Body
myItem(i).Save
End If
Next i
End If
Set fldr = Nothing
Set olApp = Nothing
End Sub