Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations bkrike on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Set "do not autoarchive" in Outlook progmmatically

VBA How To

Set "do not autoarchive" in Outlook progmmatically

by  redapples  Posted    (Edited  )
Rarely used I would suggest but I found it useful for Journal Items for a particular project I was working on. I started with a need to find out how much time I was spending on a particular project for billing purposes. To do this I had set Access documents to be recorded automatically but soon found that I had to wade through tons of irrelivant items to get the items I needed.

I then set about a quick function to add the items I need to an Access table and produce a report based on this table.
I wanted to reduce the clutter and thought autoarchiving would help.

the actual procedure for interigating the Mail box and setting the "do not AutoArchive" appears below. Not sure if it will ever be used by anyone ever (which might explain the lack of documentation on the NoAging Property) but here it is none the less

Code:
Private Sub Command0_Click()
    'Outlook objects
    Dim objOL As Outlook.Application
    Dim objNS As Outlook.NameSpace
    Dim objContactFolder As Outlook.MAPIFolder
    Dim objItems As Outlook.Items
    Dim obj As Object
    
    'ADO objects
    Dim cnn As ADODB.Connection
    Dim rs As New ADODB.Recordset
    
    Dim strFilter
    
    'Set Outlook items
    Set objOL = CreateObject("Outlook.Application")
    Set objNS = objOL.GetNamespace("MAPI")
    Set objContactFolder = objNS.GetDefaultFolder(11)
    Set objItems = objContactFolder.Items
    
    'Set connection
    Set cnn = CurrentProject.Connection
    
    'clear previous records
    DoCmd.SetWarnings False
    DoCmd.RunSQL "Delete * From table1"
    DoCmd.SetWarnings True
    
    'set string to relevant folder where items generating _
     Journal items reside
    strFilter = "M:\Net_RSI\MONITORING\Aberdeen Cyrenians"
    
    'open rs
    rs.Open "Table1", cnn, 3, 3
    
    For Each obj In objItems
        If Left(obj.Subject, Len(strFilter)) = strFilter Then
            obj.NoAging = True ' set do not auto archive
            obj.Save ' save
            
            'Populate table
            With rs
            .AddNew
            !JeDate = obj.Start
            !JeDuration = obj.Duration
            !JeSubject = obj.Subject
            .Update
            .Requery
            End With
            
        End If
    Next obj

End Sub

provided me a valuable lesson in using the Object browser effectivly if nothing else
Register to rate this FAQ  : BAD 1 2 3 4 5 6 7 8 9 10 GOOD
Please Note: 1 is Bad, 10 is Good :-)

Part and Inventory Search

Back
Top