Outlook 2003 in priponke

Zdravo!

Imam eno vprašanje, če mogoče kdo ve odgovor. Namreč, eudora ima to krasno funkcijo, da vse attachmente, ki pridejo po mejlu, zmeče v en izbran direktorij.
Zdej, outlook meče vse v en .pst fajl, ki pa ob veliki količini attachmentov rata prav nesramno velik.
A se da mogoče na kakšen način Outlook 2003 (oz. katero drgo verzijo Outlooka) prepričat v podobno dejanje, da attachmente meče v nek folder?


ThnX!

Jaz sem enmu Slovaku kodo za prenest in brisat priponke v neko mapo (iz poselektirane pošte) malo spremenil, kjer mi ni bila všeč. Če se ker spozna na outlook, lahko v parih minutah popravi, da se lahko vključi v pravila (rules), pa dela točno to kar hočeš.

Komentarji so v originalu, spremenil sem način, kako se določi mapa kamor gredo datoteke (skenslu sem FSO), pa dodal sem možnost shranjevanja datotek z enakimi imeni (dodaja i). Če kdo res hoče, da bo delalo drugače (meni tako kot je najbolj ustreza), naj pove, pa bom dodal še kakšno vrstico.

Public Sub StripAttachments()
  Dim objOL As Outlook.Application
  Dim objMsg As Object
  Dim objAttachments As Outlook.Attachments
  Dim objSelection As Outlook.Selection
  Dim i As Long
  Dim lngCount As Long
  Dim strFile As String
  Dim strFolder As String

  Set objOL = CreateObject("Outlook.Application")
  Set objSelection = objOL.ActiveExplorer.Selection

  strFolder = "X:\MojaMapa\" 'piši svoje
  If Dir(strFolder, vbDirectory) = "" Or Right$(strFolder, 1) <> "\" Then
    GoTo ExitSub
  End If
  
  For Each objMsg In objSelection
    If objMsg.Class = olMail Then
      Set objAttachments = objMsg.Attachments
      lngCount = objAttachments.Count
        If lngCount > 0 Then
          For i = lngCount To 1 Step -1
            strFile = strFolder & objAttachments.Item(i).FileName
            If Dir(strFile) <> "" Then
              Do While Dir(strFile) <> ""
                strFile = strFile & "i"
              Loop
            End If
            With objAttachments.Item(i)
              .SaveAsFile strFile
              .Delete
            End With
          Next i
        End If
        objMsg.Save
    End If
  Next

ExitSub:
  Set objAttachments = Nothing
  Set objMsg = Nothing
  Set objSelection = Nothing
  Set objOL = Nothing
End Sub