'====================================================================
' AJPapps - Trim feeds
' Линда Кайе 2013-2014. Посвящается Ариэль
' 
' Этот скрипт поможет сократить время загрузки лент RSS, удаляя 
' прочитанные сообщения. Так если в ленте максимальное количество - 
' 2500, то даже при одном непрочитанном сообщении грузиться всё 
' будет очень долго. Удаление прочитанных элементов резко сократит 
' количество сообщений и, как следствие, загрузка списка сообщений 
' будет проходить гораздо быстрее.
' 
' • 14.09.2013
'   Первая версия ^^
' 
' • 27.01.2014
'   [-] Загадочное сообщение об ошибке начало появляться там, 
'       где его не было.
' 
'====================================================================
' Маленький копирайт
' 
' 1. Программа и исходный код распространяются бесплатно.
' 2. Вы имеете право распространять их на тех же условиях.
' 3. Вы не имеете права использовать имя автора после модификации 
'    исходного кода.
' 4. При этом желательно указывать ссылку на автора оригинальной 
'    версии исходного кода.
' 5. Вы не имеете права на платное распространение исходного кода, 
'    а также программных модулей, содержащих данный исходный код.
' 6. Программа и исходный код распространяются как есть. Автор не 
'    несёт ответственности за любые трагедии или несчастные случаи, 
'    вызванные использованием программы и исходного кода.
' 7. Для любого пункта данного соглашения может быть сделано 
'    исключение с разрешения автора программы.
' 8. По любым вопросам, связанным с данной программой, обращайтесь 
'    по адресу lindaoneesama@gmail.com
' 
' Загружено с http://purl.oclc.org/Linda_Kaioh/Homepage/
'====================================================================
Option Explicit

Const AppTitle = "AJPapps - Trim feeds"

Dim Feeds
Dim nTotalMessages
Dim nDeletedMessages
Dim nErrorMessages

On Error Resume Next

Set Feeds = CreateObject("Microsoft.FeedsManager")
If Err Then
  MsgBox "Не удалось создать объект управления подписками на RSS. " & _
         "Возможно, версия Internet Explorer ниже седьмой.", _
         vbCritical, AppTitle
  WScript.Quit
End If

If MsgBox("Удалить все прочитанные сообщения в лентах?", _
          vbQuestion + vbOkCancel, AppTitle) = vbOk Then
  nTotalMessages = 0
  nDeletedMessages = 0
  nErrorMessages = 0
  
  EnumFeedsInFolder Feeds.RootFolder
  
  MsgBox "Готово ^_^v" & vbCrLf & vbCrLf & _
         "Удалено сообщений:   " & nDeletedMessages & vbCrLf & _
         "Пропущено сообщений: " & nErrorMessages & vbCrLf & _
         "Всего сообщений:     " & nTotalMessages, _
         vbInformation, AppTitle
End If

'====================================================================
Private Sub EnumFeedsInFolder(ByRef FF)
  Dim FE
  
  On Error Resume Next
  
  For Each FE In FF.Feeds
    EnumMessagesInFeed FE
  Next
  
  EnumFoldersInFolder FF
End Sub

'====================================================================
Private Sub EnumMessagesInFeed(ByRef FE)
  Dim MSG
  
  On Error Resume Next
  
  For Each MSG In FE.Items
    If MSG.IsRead Then
   	  Err.Clear
      MSG.Delete
      If Err.Number = 0 Then
        nDeletedMessages = nDeletedMessages + 1
      Else
        nErrorMessages = nErrorMessages + 1
      End If
    End If
    nTotalMessages = nTotalMessages + 1
  Next
End Sub

'====================================================================
Private Sub EnumFoldersInFolder(ByRef FF)
  Dim FE
  
  On Error Resume Next
  
  For Each FE In FF.Subfolders
    EnumFeedsInFolder FE
  Next
End Sub