Pentru ca www.inforss.ro nu mai merge ( deh, banii) am vrut sa gasesc un RSS Reader care sa vada ce este nou dintr-o lista uriasa si sa il puna intr-un HTML pe care sa il pot citi dupa aceea(de preferinta, de trimis pe email)

Prima optiune – si ultima, din pacate – Outlook 2007. Are RSS Foldere – ce mai trebuia facut

1. Adaugat RSS-urile deja existente
2. Copiat RSS-urile noi, cele sub forma de email, intr-un HTML
3. Sters email-urile citite dupa o perioada data.

Pentru 1 , outlook deja stie OPML – iar , pentru memorie, iata OPML-ul meu de odinioara, cind aveam timp

http://serviciipeweb.ro/iafblog/content/binary/RSS_OPML.zip

 

Pentru copiat am facut rapid un macro de outlook:

Private Sub ConcentrateRSSToFile()

Dim strNameFile As String

‘TODO : maybe change name?

strNameFile = “C:\rss” & Format(Now, “yyyyMMdd_HHmmss”) & “.html”

 

Dim flRss As Folder

Set flRss = Application.GetNamespace(“MAPI”).GetDefaultFolder(olFolderRssFeeds)

Dim flRssLoop As Folder

Dim strContents As String

For Each flRssLoop In flRss.Folders

Dim oLoop As Object, m As PostItem

For Each oLoop In flRssLoop.Items

If Not TypeOf oLoop Is PostItem Then GoTo NextItem

Set m = oLoop

If Not m.UnRead Then GoTo NextItem

m.UnRead = False

strContents = strContents & “<B>” & Trim(m.Subject) & “</B>”

strContents = strContents & vbCrLf

strContents = strContents & “<BR>”

strContents = strContents & vbCrLf

strContents = strContents & Trim(m.HTMLBody)

strContents = strContents & vbCrLf

strContents = strContents & “<BR>”

strContents = strContents & vbCrLf

NextItem:

Next oLoop

 

If Len(strContents) > 0 Then

 

Open strNameFile For Append As #1

Print #1, strContents

Close #1

End If

strContents = “”

Next flRssLoop

 

 

End Sub

 

 

Destul de simplu, nu ?

Pentru stergera lor am avut probleme…AutoArchive nu apare in VBA de outlook… UpdateFolderTreeArchiveSettings

Dar in schimb am gasit un cod care aplica recursiv autoarchive de la un folder parinte la toti copiii lui – asa ca nu fac decit sa il copiez aici, dind credit la

http://blogs.msdn.com/jmazner/archive/2006/10/30/setting-autoarchive-properties-on-a-folder-hierarchy-in-outlook-2007.aspx

(culmea , tot pentru RSS a avut nevoie)

 

 

Option Explicit

 

‘——————————————————————————

‘

‘ Hex values for the Exchange properties that govern aging / archiving

‘

‘——————————————————————————

Public Const hexPR_AGING_AGE_FOLDER = &H6857000B ‘ BOOL Enable aging aka Archive for this folder: True = Enabled False = Disabled

Public Const hexPR_AGING_GRANULARITY = &H36EE0003 ‘LONG Aging granularity: 0 = Months 1 = Weeks 2 = Days

Public Const hexPR_AGING_PERIOD = &H36EC0003 ‘ LONG, duration from 1 to 999 (combined with AGING GRANULARITY)

Public Const hexPR_AGING_DELETE_ITEMS = &H6855000B ‘ BOOL FALSE = archive, TRUE = permanently delete

Public Const hexPR_AGING_FILE_NAME_AFTER9 = &H6859001E ‘ STRING Path and filename of archive file for Exchange version > Exchange 9

Public Const hexPR_AGING_DEFAULT = &H685E0003 ‘ LONG values unclear, seems like 3=do not archive, 1=archive according to defaults, 0=custom settings

‘ the values below are not relevant to folder settings

‘Public Const hexPR_AGING_FILE_NAME9_AND_PREV = &H6856001E ‘ STRING Path and filename of archive file for Exchange version <= Exchange 9

‘Public Const hexPR_AGING_DONT_AGE_ME = &H6858000B ‘ BOOL

‘Public Const hexPR_AGING_WHEN_DELETED_ON_SERVER = &H685B000B ‘ BOOL

‘Public Const hexPR_AGING_WAIT_UNTIL_EXPIRED = &H685C000B ‘ BOOL

‘Public Const hexPR_AGING_VERSION = &H685D0003 ‘ LONG

 

‘ Properties for aging granularity

Public Const AG_MONTHS = 0

Public Const AG_WEEKS = 1

Public Const AG_DAYS = 2

 

Public Const strProptagURL As String = “http://schemas.microsoft.com/mapi/proptag/0x”

 

‘——————————————————————————

‘

‘ String values for the Exchange properties that govern aging / archiving

‘

‘——————————————————————————

Public Const strPR_AGING_AGE_FOLDER As String = strProptagURL + “6857000B”

Public Const strPR_AGING_PERIOD As String = strProptagURL + “36EC0003”

Public Const strPR_AGING_GRANULARITY As String = strProptagURL + “36EE0003”

Public Const strPR_AGING_DELETE_ITEMS As String = strProptagURL + “6855000B”

Public Const strPR_AGING_FILE_NAME_AFTER9 As String = strProptagURL + “6859001E”

Public Const strPR_AGING_DEFAULT As String = strProptagURL + “685E0003”

‘Public Const strPR_AGING_FILE_NAME9_AND_PREV As String = strProptagURL + “6856001E”

‘Public Const strPR_AGING_DONT_AGE_ME As String = strProptagURL + “6858000B”

‘Public Const strPR_AGING_WHEN_DELETED_ON_SERVER As String = strProptagURL + “685B000B”

‘Public Const strPR_AGING_WAIT_UNTIL_EXPIRED As String = strProptagURL + “685C000B”

‘Public Const strPR_AGING_VERSION As String = strProptagURL + “685D0003”

 

‘——————————————————————————

‘

‘ UpdateFolderTreeArchiveSettings

‘

‘ Asks the user to choose a folder, reads that folder’s auto-archive settings,

‘ and then applies those settings recursively to all child folders

‘

‘——————————————————————————

Sub UpdateFolderTreeArchiveSettings()

Dim ns As NameSpace

Dim oRootFolder As Folder

Dim oFold As Folder

 

Dim AgeFolder As Boolean, DeleteItems As Boolean, _

FileName As String, Granularity As Integer, _

Period As Integer, Default As Integer

 

Set ns = Application.GetNamespace(“MAPI”)

Set oRootFolder = ns.PickFolder

 

GetCurrentAgingProperties oRootFolder, AgeFolder, DeleteItems, FileName, Granularity, Period, Default

 

RecursivelyApplyChanges oRootFolder, AgeFolder, DeleteItems, FileName, Granularity, Period, Default

 

 

End Sub

‘——————————————————————————

‘

‘ RecursivelyApplyChanges

‘

‘ The tail-recursive procedure

‘

‘——————————————————————————

Sub RecursivelyApplyChanges(oFolder As Outlook.Folder, AgeFolder As Boolean, DeleteItems As Boolean, _

FileName As String, Granularity As Integer, _

Period As Integer, Default As Integer)

 

Dim oCurFolder As Folder

 

ChangeAgingProperties oFolder, AgeFolder, DeleteItems, FileName, Granularity, Period, Default

 

For Each oCurFolder In oFolder.Folders

RecursivelyApplyChanges oCurFolder, AgeFolder, DeleteItems, FileName, Granularity, Period, Default

Next oCurFolder

 

End Sub

 

‘——————————————————————————

‘

‘ ChangeAgingProperties

‘

‘ Cribbed mostly from help topic “”

‘ http://officebeta.iponet.net/client/helppreview.aspx?AssetID=HV100458931033&ns=OUTLOOK.DEV&lcid=1033&CTT=3&Origin=HV100433811033

‘

‘ But fixed two apparent bugs

‘ 1) should use PR_AGING_FILE_NAME_AFTER9 for file name

‘ 2) set PR_AGING_DEFAULT, since that’s what Oulook does when using the UI

‘

‘——————————————————————————

Function ChangeAgingProperties(oFolder As Outlook.Folder, _

AgeFolder As Boolean, DeleteItems As Boolean, _

FileName As String, Granularity As Integer, _

Period As Integer, Default As Integer) As Boolean

 

Dim oStorage As StorageItem

Dim oPA As PropertyAccessor

 

Debug.Print “Updating ” + oFolder.Name

 

‘Valid Period 1-999

‘Valid Granularity 0=Months, 1=Weeks, 2=Days

If (oFolder Is Nothing) Or _

(Granularity < 0 Or Granularity > 2) Or _

(Period < 1 Or Period > 999) Then

ChangeAgingProperties = False

End If

 

On Error GoTo Aging_ErrTrap

 

‘Create or get solution storage in given folder by message class

Set oStorage = oFolder.GetStorage( _

“IPC.MS.Outlook.AgingProperties”, olIdentifyByMessageClass)

Set oPA = oStorage.PropertyAccessor

 

If Not (AgeFolder) Then

oPA.SetProperty strPR_AGING_AGE_FOLDER, False

Else

‘Set the 5 aging properties in the solution storage

oPA.SetProperty strPR_AGING_AGE_FOLDER, True

oPA.SetProperty strPR_AGING_GRANULARITY, Granularity

oPA.SetProperty strPR_AGING_DELETE_ITEMS, DeleteItems

oPA.SetProperty strPR_AGING_PERIOD, Period

If FileName <> “” Then

oPA.SetProperty strPR_AGING_FILE_NAME_AFTER9, FileName

End If

oPA.SetProperty strPR_AGING_DEFAULT, Default

End If

‘Save changes as hidden messages to the associated portion of the folder

oStorage.Save

ChangeAgingProperties = True

Exit Function

 

Aging_ErrTrap:

Debug.Print Err.Number, Err.Description

ChangeAgingProperties = False

End Function

 

‘——————————————————————————

‘

‘ GetCurrentAgingProperties

‘

‘ updates ByRef paramaters with values of the indicated folder

‘

‘——————————————————————————

 

Function GetCurrentAgingProperties(oFolder As Outlook.Folder, _

ByRef AgeFolder As Boolean, ByRef DeleteItems As Boolean, _

ByRef FileName As String, ByRef Granularity As Integer, _

ByRef Period As Integer, ByRef Default As Integer) As Boolean

 

Dim oStorage As StorageItem

Dim oPA As PropertyAccessor

 

Debug.Print “Fetching values for ” + oFolder.Name

 

On Error GoTo Aging_ErrTrap

 

‘Create or get solution storage in given folder by message class

Set oStorage = oFolder.GetStorage( _

“IPC.MS.Outlook.AgingProperties”, olIdentifyByMessageClass)

Set oPA = oStorage.PropertyAccessor

 

AgeFolder = oPA.GetProperty(strPR_AGING_AGE_FOLDER)

Granularity = oPA.GetProperty(strPR_AGING_GRANULARITY)

DeleteItems = oPA.GetProperty(strPR_AGING_DELETE_ITEMS)

Period = oPA.GetProperty(strPR_AGING_PERIOD)

FileName = oPA.GetProperty(strPR_AGING_FILE_NAME_AFTER9)

Default = oPA.GetProperty(strPR_AGING_DEFAULT)

 

PrintFolderSettings oFolder

 

GetCurrentAgingProperties = True

 

Exit Function

 

Aging_ErrTrap:

Debug.Print Err.Number, Err.Description

GetCurrentAgingProperties = False

End Function

 

‘——————————————————————————

‘

‘ PrintFolderSettings

‘

‘ Utility procedure for printing current folder settings to console window

‘

‘ Unlike the functions above, which get the archive settings row via GetStorage,

‘ this procedure uses a closer-to-the-metal approach of querying the folder for

‘ its hidden items. No reason for this, other than I wanted to learn more about

‘ how these archive items really work.

‘

‘ Note that this function assumes that the only hidden item in a folder is the

‘ IPC.MS.Outlook.AgingProperties item.

‘

‘——————————————————————————

 

Sub PrintFolderSettings(oFolder As Outlook.Folder)

 

Dim oTable As Outlook.Table

Dim oRow As Outlook.Row

 

 

Set oTable = oFolder.GetTable(TableContents:=olHiddenItems)

 

Debug.Print (“Values for hidden items in folder ” + oFolder.Name)

 

 

oTable.Columns.RemoveAll

‘Specify desired properties

With oTable.Columns

.Add (strPR_AGING_PERIOD)

.Add (strPR_AGING_GRANULARITY)

.Add (strPR_AGING_DELETE_ITEMS)

.Add (strPR_AGING_AGE_FOLDER)

.Add (strPR_AGING_FILE_NAME_AFTER9)

.Add (strPR_AGING_DEFAULT)

‘.Add (strPR_AGING_FILE_NAME9_AND_PREV)

‘.Add (strPR_AGING_DONT_AGE_ME)

‘.Add (strPR_AGING_WHEN_DELETED_ON_SERVER)

‘.Add (strPR_AGING_WAIT_UNTIL_EXPIRED)

‘.Add (strPR_AGING_VERSION)

End With

 

If Not (oTable Is Nothing) Then

Do Until (oTable.EndOfTable)

Set oRow = oTable.GetNextRow()

Debug.Print (“PR_AGING_PERIOD: ” + CStr(oRow(strPR_AGING_PERIOD)))

Debug.Print (“PR_AGING_GRANULARITY: ” + CStr(oRow(strPR_AGING_GRANULARITY)))

Debug.Print (“PR_AGING_DELETE_ITEMS: ” + CStr(oRow(strPR_AGING_DELETE_ITEMS)))

Debug.Print (“PR_AGING_AGE_FOLDER: ” + CStr(oRow(strPR_AGING_AGE_FOLDER)))

Debug.Print (“PR_AGING_FILE_NAME_AFTER9: ” + CStr(oRow(strPR_AGING_FILE_NAME_AFTER9)))

Debug.Print (“PR_AGING_DEFAULT: ” + CStr(oRow(strPR_AGING_DEFAULT)))

‘Debug.Print (“PR_AGING_FILE_NAME9_AND_PREV: ” + CStr(oRow(strPR_AGING_FILE_NAME9_AND_PREV)))

‘Debug.Print (“PR_AGING_DONT_AGE_ME: ” + CStr(oRow(strPR_AGING_DONT_AGE_ME)))

‘Debug.Print (“PR_AGING_WHEN_DELETED_ON_SERVER: ” + CStr(oRow(strPR_AGING_WHEN_DELETED_ON_SERVER)))

‘Debug.Print (“PR_AGING_WAIT_UNTIL_EXPIRED: ” + CStr(oRow(strPR_AGING_WAIT_UNTIL_EXPIRED)))

‘Debug.Print (“PR_AGING_VERSION: ” + CStr(oRow(strPR_AGING_VERSION)))

Loop

End If

 

End Sub

Ce a rezultat ? http://serviciipeweb.ro/iafblog/content/binary/rss20080926_035338.zip

Practic si teoretic nu mai am nevoie de un alt RSS Reader …desi mai am o problema :ar trebui sa transform codul intr-un addin de Outlook …