M$ Outlook 2000: Jak uložit přílohy z mejlů pomocí VBA?

V ideálním případě by stačilo toto:

Sub SaveAllAttachementsFromInbox(ByVal ToPath As String)
'JMA 30.11.2007 studijní příklad uložení e-mailů z Outlooku
'I: ToPath ... cesta pro uložení příloh; musí končit zpětným lomítkem
On Error GoTo EH
  Dim ouApp As Outlook.Application
  Dim ouFolder As Outlook.MAPIFolder
  Dim oUnknownItem As Object
  Dim ouMail As Outlook.MailItem
  Dim ouAtt As Outlook.Attachment
  
  Set ouApp = New Outlook.Application
  Set ouFolder = ouApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
  
  For Each oUnknownItem In ouFolder.Items
    If TypeOf oUnknownItem Is Outlook.MailItem Then 'mohou být i položky jiných typů
      Set ouMail = oUnknownItem
      For Each ouAtt In ouMail.Attachments
        ouAtt.SaveAsFile ToPath & ouAtt.FileName
      Next
    Set ouMail = Nothing
    End If
  Next
EX:
  Set ouAtt = Nothing
  Set oUnknownItem = Nothing
  Set ouMail = Nothing
  Set ouFolder = Nothing
  If Not ouApp Is Nothing Then ouApp.Quit
  Set ouApp = Nothing
  Exit Sub
EH:
  MsgBox Err.Description
  Resume EX
  Resume 'pro účely ladění
End Sub

Použité knihovny:

• Microsoft Outlook 9.0 Object Library

Problematické okamžiky:

1. na disku existuje soubor stejného jména => nebudu-li testovat podle obsahu souboru, ověřím alespoň velikost - pokud je jiná, uložím soubor pod jiným jménem, tj. přidám podtržítko za název souboru a znovu ověřím
2. název souboru obsahuje znaky nepřípustné pro uložení => je třeba je odfiltrovat (např. nahradit podtržítkem)
3. dopředu nevím, která verze knihovny bude ve použita => musím zrušit zatržení knihovny, Dim všech Outlook.* objektů předělat na typ Object a změnit získání objektu Outlook.Application z New na CreateObject (... toto není ve funkcích aplikováno kvůli názornosti)
4. použitím Set oa= New Outlook.Application získám vždy novou instanci programu, což je zbytečné, pokud je Outlook již otevřen. U starších strojů trvá spuštění déle a nová instance zbytečně zaplňuje paměť => mám dvě řešení:
   1. kód umístím přímo do aplikace M$ Outlook, pak získám objekt aplikace takto: Set oa = Me
   2. použiji GetObject - viz extra funkce getOutlookApp
5. ve složce Outlooku mohou být umístěny také položky jiných typů než e-milové zprávy, např. událost atd. proto je vhodné před dalším zpracováním otestovat typ položky a zpracovávat jen mejly.
6. pokud je přílohou některé zprávy další celá zpráva, lze zprávu z přílohy rekurzivně zpracovat, až se dostaneme k opravdové příloze
7. Tip: pokud chceme položky z kolekce mazat (např. smazat mejly po uložení příloh), samozřejmě nemůžeme v cyklu mazat od první položky do poslední pomocí Each, ale musíme mazat od poslední do první: For i = myFolder.Items.Count To 1 Step -1.

K řešení některých problematických okamžiků

Public Function getOutlookApp() As Outlook.Application
'JMA 6/05 vrátí objekt buď již otevřené aplikace nebo spustí novou
On Error Resume Next
  Dim ou As Outlook.Application ' Object
  Set ou = GetObject(, "Outlook.Application")
  If Err.Number <> 0 Then
    Err.Clear
    Set ou = CreateObject("Outlook.Application")
  End If
  Set getOutlookApp = ou
End Function