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
- Adaugat RSS-urile deja existente
- Copiat RSS-urile noi, cele sub forma de email, intr-un HTML
- 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
(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 …