[VBA] Save attachments uit embedded mail

Pagina: 1
Acties:

Vraag


Acties:
  • 0 Henk 'm!

  • P_Tingen
  • Registratie: Maart 2005
  • Laatst online: 08:44

P_Tingen

omdat het KAN

Topicstarter
Situatie
Voor de orderverwerking lezen we de mail die binnenkomt in Outlook. De mail wordt via regels naar een order-map gestuurd, waarna een VBA macro er voor zorgt dat de bijlagen worden opgeslagen in een map op schijf. Onze eigen software pakt vanaf daar dan de orders weer op. Dit gaat niet goed wanneer klanten een mail-in-een-mail sturen, dus een embedded mail:

Afbeeldingslocatie: https://tweakers.net/i/zl1lllrNo2CAzKLVQSh7n5XHc8s=/full-fit-in/4000x4000/filters:no_upscale():fill(white):strip_exif()/f/image/VTVadNS3MREZPAMcJ4X1TdeE.png?f=user_large

Wat er dan op schijf komt te staan is een .msg file in plaats van een .pdf of .xlsx bestand wat normaal gesproken gebeurt. Ik wil graag de .msg file bekijken en de bijlagen dáár weer uit opslaan.

Relevante software en hardware die ik gebruik
Outlook 365

Wat ik al gevonden of geprobeerd heb
Zie hieronder voor een versimpelde versie van mijn macro. Als je dit zelf wil proberen, pas dan op regel 7 de naam van de folder aan in Outlook waarvan je de bijlagen wilt bewaren en op regel 28 evt de map waar het naar toe moet (nu respectievelijk "orders" en "c:\temp\mail")

Dit werkt voor bijlagen, maar het gaat fout op regel 25-27. Hier dacht ik slim een recursieve aanroep te doen naar SaveToDisk, maar mijn objAtt is niet van type olMailItem maar altijd olAttachment en de check gaag dan ook mis. Bij een testmail had ik de check even uitgeschakeld, maar ook al zou de IF goed gaan, dan nog gaat het fout omdat SaveToDisk een MailItem verwacht als input en geen Attachment

code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Sub SaveAttachments()
    Dim ns As Outlook.NameSpace
    Dim myItem As Object
    Dim i As Integer
    
    Set ns = Application.GetNamespace("MAPI")
    Set FolderItems = ns.GetDefaultFolder(olFolderInbox).Folders("Orders").Items
    
    For i = 1 To FolderItems.Count
        Set myItem = FolderItems(i)
        SaveToDisk myItem
    Next
End Sub


Sub SaveToDisk(objMsg As MailItem)
    Dim i As Integer
    Dim objAtt As Attachment
    Dim cFile As String
    
    If objMsg.Attachments.Count > 0 Then
        For i = 1 To objMsg.Attachments.Count
            Set objAtt = objMsg.Attachments(i)
            
            If objAtt.Class = olMailItem Then
              SaveToDisk objMsg
            Else
              cFile = "c:\temp\mail\mail-" & Format(objMsg.ReceivedTime, "hhmmss") & "-" & Replace(objAtt.FileName, " ", "_")
              objAtt.SaveAsFile cFile
            End If
        Next
    End If
End Sub

Suggesties zijn welkom ...

... en gaat over tot de orde van de dag

Beste antwoord (via P_Tingen op 02-07-2020 13:04)


  • Kalentum
  • Registratie: Juni 2004
  • Nu online
P_Tingen schreef op donderdag 2 juli 2020 @ 08:44:
Probleem is: hoe doe ik dat in VBA?
Google eens op "VBA read msg file" en dat soort termen.

Alle reacties


Acties:
  • 0 Henk 'm!

  • Patrock
  • Registratie: Augustus 2011
  • Laatst online: 10:45

Patrock

Eat - ride - sleep - repeat

Dus ALLE bijlagen worden nu mooi automatisch opgeslagen, en aangeroepen?...

Ik kan helaas geen on-topic reactie leveren, maar misschien is verdere validatie of een andere manier voor het verzamelen van de orders iets waar ook over nagedacht kan worden. Ook omdat spamfilters soms erg hardnekkig kunnen zijn op orderformulieren in excel/pdf als bijlage. Die van Office 365 kunnen behoorlijk veel blokkeren namelijk.

Acties:
  • 0 Henk 'm!

  • P_Tingen
  • Registratie: Maart 2005
  • Laatst online: 08:44

P_Tingen

omdat het KAN

Topicstarter
Patrock schreef op woensdag 1 juli 2020 @ 13:40:
Dus ALLE bijlagen worden nu mooi automatisch opgeslagen, en aangeroepen?...

Ik kan helaas geen on-topic reactie leveren, maar misschien is verdere validatie of een andere manier voor het verzamelen van de orders iets waar ook over nagedacht kan worden. Ook omdat spamfilters soms erg hardnekkig kunnen zijn op orderformulieren in excel/pdf als bijlage. Die van Office 365 kunnen behoorlijk veel blokkeren namelijk.
Ja, op zich werkt dit systeem al een paar jaar goed. Spamfilters hebben we niet zoveel last van gelukkig. Aan de achterkant worden de bijlagen opgepakt en geanalyseerd door onze eigen software. Bijlagen die niet herkend worden, worden apart gezet. Alleen mail-in-mail gaat dus nog niet goed

... en gaat over tot de orde van de dag


Acties:
  • 0 Henk 'm!

  • RedFox
  • Registratie: November 2001
  • Laatst online: 09:51

RedFox

Heb je een OV ofzo?

Geen ervaring met Outlook macro's, maar wat ik online tegenkom is dat je een embedded mail eerst moet downloaden en daarna openen. Dan kan je pas bij de attachments. Je zal dus moeten checken wat voor type attachments je hoofd mail heeft en op basis daarvan ze verwerken.

You are not special. You are not a beautiful or unique snowflake. You're the same decaying organic matter as everything else.


Acties:
  • 0 Henk 'm!

  • P_Tingen
  • Registratie: Maart 2005
  • Laatst online: 08:44

P_Tingen

omdat het KAN

Topicstarter
Het item wat ik meegeef aan SaveToDisk is van het type 'attachment'. Ik zou hem eigenlijk moeten casten naar het type 'mailItem', maar hoe?

... en gaat over tot de orde van de dag


Acties:
  • 0 Henk 'm!

  • farlane
  • Registratie: Maart 2000
  • Laatst online: 07-07 21:52
Als je de attachment als .msg hebt opgeslagen zou je em kunnen openen en dan de attachments opslaan. Voeg naar smaak recursie toe.

Somniferous whisperings of scarlet fields. Sleep calling me and in my dreams i wander. My reality is abandoned (I traverse afar). Not a care if I never everwake.


Acties:
  • 0 Henk 'm!

  • P_Tingen
  • Registratie: Maart 2005
  • Laatst online: 08:44

P_Tingen

omdat het KAN

Topicstarter
Probleem is: hoe doe ik dat in VBA?

... en gaat over tot de orde van de dag


Acties:
  • 0 Henk 'm!

  • eheijnen
  • Registratie: Juli 2008
  • Niet online
Jouw probleemstelling (er is een mail item als attachment bijgesloten) heb je al geformuleerd in de door jouw aangeleverde tekst.
Een beetje leesvoer over recursie (een routine die zichzelf aanroept - onder bepaalde condities -)
https://docs.microsoft.co...ting-recursive-procedures

Deze uitleg is in C maar de logica blijft gelijk in een andere programmeertaal.
https://www.cs.cmu.edu/~a...ecursions/recursions.html

Wie du mir, so ich dir.


Acties:
  • Beste antwoord
  • 0 Henk 'm!

  • Kalentum
  • Registratie: Juni 2004
  • Nu online
P_Tingen schreef op donderdag 2 juli 2020 @ 08:44:
Probleem is: hoe doe ik dat in VBA?
Google eens op "VBA read msg file" en dat soort termen.

Acties:
  • +1 Henk 'm!

  • P_Tingen
  • Registratie: Maart 2005
  • Laatst online: 08:44

P_Tingen

omdat het KAN

Topicstarter
Kalentum schreef op donderdag 2 juli 2020 @ 09:11:
[...]
Google eens op "VBA read msg file" en dat soort termen.
Op stackexchange een oplossing gevonden en uiteindelijk is het best mooi geworden:

code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
Global ns As Outlook.NameSpace
Global oInBox As Outlook.Folder
Global oTodo As Outlook.Folder
Global oDone As Outlook.Folder
Dim cSave As String

Sub VerwerkOrders()
    Dim oMsg As Object
    Dim i As Integer
    
    Set ns = Application.GetNamespace("MAPI")
    Set oInBox = ns.GetDefaultFolder(olFolderInbox)
    Set oTodo = oInBox.Folders("Orders")
    Set oDone = oInBox.Folders("Archief orders")
    cSave = "c:\temp\mail\"
    
    For i = oTodo.Items.Count To 1 Step -1
        Set oMsg = oTodo.Items(i)
        SaveAttachments oMsg
        oMsg.Move oDone
    Next
End Sub

Sub SaveAttachments(oMsg As MailItem)
    Dim oAtt As Outlook.Attachment
    Dim oItem As Object
    Dim i As Integer
    Dim cFile As String
    Dim cExt As String
        
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    For i = 1 To oMsg.Attachments.Count
        Set oAtt = oMsg.Attachments(i)
        
        cExt = LCase(Mid(oAtt.Filename, InStrRev("." & oAtt.Filename, ".")))
        
        If InStr("csv pdf xls xlsx msg", cExt) > 0 Then
            cFile = cSave & Format(oMsg.ReceivedTime, "hhmmss") & "-" & oAtt.Filename
            oAtt.SaveAsFile cFile
        End If 'check extentie
                          
        If cExt = "msg" Then
            Set oItem = ns.OpenSharedItem(cFile)
            SaveAttachments oItem
            oItem.Move oDone
            fso.deletefile cFile
        End If 'msg file
    Next
End Sub


Regel 15 gaat nog veranderd worden. In plaats van c:\temp wordt dat een netwerk-share waar ons orderprogramma de bijlagen oppakt.

[ Voor 81% gewijzigd door P_Tingen op 02-07-2020 13:05 ]

... en gaat over tot de orde van de dag

Pagina: 1