JMA
tuzka.cz
Ing. Jan Matuška tvorba databází a webu kontakt
služby+sw
software
exShop je pohoda!
KOALA
Kniha pošty
projekty
webdesign
o firmě
tipy kolegům
VBA
Dokončit import
FreeImage
ZIPování
TCP/IP
Outlook-přílohy
Access
HWIZ
Zdroje informací
Upload
Z autorské tvorby
Fotografie
Sbírka básní
Plakát
Přečtěte si
Jak a proč jsem se stal křesťanem
Víte, že AHOJ je zkratka?
Poznat Boha, ale jak?
... další přímo na stránkách BTM

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
Doporučuji
Exit 316
Letní tábor Doubravka 2009 s Beberkou
Exit 316
Nový TV pořad od září 2006!
Pro děti - zvědavé otázky se Zvědavou tužkou
KROKY - Časopis pro děti
křesťanská díla, CF - nejen databáze křesťanských písní
Komerce atd.
Podpořte snahu proti zavedení SW patentů!!!
profi webhosting Gigaweb
Nabídka SW a služeb
Kniha pošty
KOALA
Tvorba www
Umístění stránek
Chcete internetový obchod?