Acces 2016 Save alle bijlagen van een geselecteerde email

Status
Niet open voor verdere reacties.

KPTPTT

Gebruiker
Lid geworden
2 mrt 2018
Berichten
321
Hallo. Mijn volgende "puzzel" krijg ik helaas niet aan de praat.
In Outlook worden vele emails met bijlagen ontvangen. Van slechts steeds één door de gebruiker geselecteerde c.q. geopende email wil ik na een druk op de formulier knop de bijlage(n) van deze email opslaan op de hd. In een verder stadium wil ik deze als bijlage opslaan in de db. Bij het zoeken via google vind je vaak dezelfde oplossingen (vaak overgenomen van snb !!) waarbij de bijlagen van alle emails worden opgeslagen. Dat is niet wat ik zoek, nl. de bijlagen van één geopende email.
Ik heb de regel waarbij elke email item wordt gescand buiten werking gesteld maar dat levert de bug: Fout 91 Objectvariabele of blokvariabele With is niet ingesteld. Ik heb van alles "getest" maar kom er niet uit. Wie weet een oplossing?
Opm.: Ik vond een leerzame site met veel email variaties, van snb? <http://www.snb-vba.eu/VBA_Outlook_external.html>
Code:
Private Sub Knop181_Click()

Dim Item As Outlook.MailItem
Dim Atmt As Outlook.Attachment
Dim Filename As String

  'For Each Item In CreateObject("Outlook.application").GetNamespace("MAPI").GetDefaultFolder(6).Items

        For Each Atmt In Item.Attachments
            Tmp = Split(Atmt.Filename, ".")
            Debug.Print Atmt
            Select Case Tmp(UBound(Tmp))
                Case "pdf", "xls", "xlsx", "doc", "docx", "jpg"
                    Filename = "D:\Bijlagen_email_db\" & Atmt.Filename
                    Attachments.SaveAsFile Filename
                                End Select
        Next
                                'End Select
End Sub
 
Ik gebruik al jaren een procedure van voor de ‘geboorte’ van snb, die perfect werkt. Ik zal ‘m morgen voor je opzoeken, want ik gebruik hem op mijn werk en niet thuis.
 
Bedankt voor je bericht. Ik wacht met spanning af. Ik weet niet hoe oud snb is maar de code moet dan vast niet zo oud zijn :). Na vele uren zoeken op internet en "proberen" vind ik een code van edmoor die deels werkt.
De attachment van de geselecteerde email (focus op de betreffende email is voldoende) wordt opgeslagen, dat is precies wat ik zoek. Maar, ondanks de For-Next loop wordt alleen de eerste attachment opgeslagen, de overige worden genegeerd. Na de laatste Next-statement loopt het programma direct door naar de regel "Set currentExplorer = Nothing" in plaats van weer naar For Each. De statements worden dus maar één keer doorlopen terwijl er meerdere attachment staan (3 sts). Hoe kan dit?

Omdat ik meerdere type extensies wilt herkennen heb ik de code uitgevoerd met Case . . .. Ik heb nog geen betere manier gevonden voor het onderscheidt tussen 3 en 4 karakters door met bv. .png en .doc te werken. Is er een betere een oplossing>
Alvast bedankt voor het meedenken.

Code:
Private Sub Knop181_Click()
    Dim currentExplorer As Explorer
    Dim obj As Object
    Dim Ext As String

    Set currentExplorer = ActiveExplorer
    Set Selection = currentExplorer.Selection

    For Each obj In Selection
       With obj
           If .Attachments.Count > 0 Then
                Ext = Right(.Attachments(1).Filename, 4)
                    Select Case Ext
                        Case ".pdf", ".xls", "xlsx", ".doc", "docx", ".jpg", "jpeg", ".png", ".msg"
                            .Attachments(1).SaveAsFile "D:\Bijlagen_email_db\" & .Attachments(1).Filename
                    End Select
               'End If
           End If
       End With
    Next

    Set currentExplorer = Nothing
    Set Selection = Nothing
    Set obj = Nothing
End Sub
 
Laatst bewerkt:
Zo uit mijn hoofd, zou het zoiets moeten zijn:
Code:
Private Sub Knop181_Click()
Dim currentExplorer As Explorer
Dim obj As Object, att As Object
Dim Ext As String

    Set currentExplorer = ActiveExplorer
    Set Selection = currentExplorer.Selection
    For Each obj In Selection
        With obj
            If .Attachments.Count > 0 Then
                For Each att In .Attachments
                    Ext = Right(att.FileName, 4)
                    Select Case Ext
                        Case ".pdf", ".xls", "xlsx", ".doc", "docx", ".jpg", "jpeg", ".png", ".msg"
                            att.SaveAsFile "D:\Bijlagen_email_db\" & att.FileName
                    End Select
                Next att
            End If
       End With
    Next obj

End Sub
 
Dank je wel OctaFish. Je code werkt goed en alle bijlagen van de geselecteerde email worden opgeslagen. Ik vind wel vreemd dat er nu twee For Each - Next lussen zijn om de bijlagen te detecteren en op te slaan. De eerste lus werkt niet als een lus maar wordt eenmaal doorlopen, de tweede lus herkent alle bijlagen. Is daar een verklaring voor? In ieder geval werkt het.

De code werkt alleen als Outlook is opgestart. Is Outlook niet actief, dan is er een foutmelding. Om dat te omzeilen wordt Outlook in <Form_load> automatisch opgestart. Ook dit werkt, echter met af en toe een foutmelding. De volgende situatie leidt tot een foutmelding.
Formulier Bijlagen wordt geopend, Outlook wordt automatisch gestart, focus is automatisch op eerste emailbericht. Knop181 wordt gedrukt, Bijlagen worden opgeslagen. Dit is OK. Tweede test: Outlook wordt afgesloten. Formulier Bijlagen wordt geopend, Outlook wordt automatisch gestart. Knop181 wordt gedrukt, af en toe een foutmelding in regel: < Set currentExplorer = ActiveExplorer> Foutmelding: < Fout 462. De externe servercomputer bestaat niet of is niet beschikbaar>. Ik heb in het Direct Venster de debug-code ?ActiveExplorer opgegeven en krijg dezelfde foutmelding. Ik heb de code aangepast in aanbevolen code: <Set currentExplorer = Application.ActiveExplorer>, maar dan krijg ik de foutmelding <Kan methode of gegevenslid niet vinden>. De code ziet dus het object niet. Misschien een tijdissue, hoewel Outlook is gestart en volop in beeld staat en daarna pas de knop181 wordt gedrukt. Waarom wordt Outlook niet "gezien"?

Code:
Private Sub Form_Load()                                         'Formulier Bijlagen wordt gestart
Dim oOutlook As Object
    Set oOutlook = GetObject(, "Outlook.Application")           'Outlook starten indien deze niet is geopend
On Error GoTo 0

    If oOutlook Is Nothing Then
        Shell ("OUTLOOK")
    End If
End Sub

Code:
Private Sub Knop181_Click()
Dim currentExplorer As Explorer
Dim obj As Object, att As Object
Dim Ext As String

    Set currentExplorer = ActiveExplorer            'Af en toe een foutmelding op deze regel
    Set Selection = currentExplorer.Selection
    For Each obj In Selection
        With obj
            If .Attachments.Count > 0 Then
                For Each att In .Attachments
                    Ext = Right(att.Filename, 4)
                    Select Case Ext
                        Case ".pdf", ".xls", "xlsx", ".doc", "docx", ".jpg", "jpeg", ".png", ".msg"
                            att.SaveAsFile "D:\Bijlagen_email_db\" & att.Filename
                    End Select
                Next att
            Else
                MsgBox "Er zijn geen bijlagen in de email"
            End If
       End With
    Next obj
End Sub
 
Laatst bewerkt:
Ik vind je procedure een beetje omslachtig, dan wel nodeloos ingewikkeld. Als je Outlook gebruikt, waarom dan via Late Binding? Waarom Outlook starten bij het laden van het formulier? Waarom sluit je het formulier als je na één mail de import klaar hebt?
Jouw code pakt sowieso maar één mail, dus de eerste lus doet inderdaad niks. Als je een complete map wilt opslaan, kun je beter een routine gebruiken die een map uitleest, en niet één(of een selectie van) mail.
 
Dank. De aangepaste code werkt goed als Outlook is en blijft gestart. Als Outlook niet is gestart en het formulier wordt geopend, dan krijg je een foutmelding in de regel <Set currentExplorer = ActiveExplorer>. Dat is niet zo'n succes, dus om de gebruiker voor te zijn, start ik automatisch Outlook voordat de bijlagen door de knop kunnen worden opgeslagen. Zou er dus in theorie niets mis moeten gaan. Bij het testen ga je van allerlei situaties uit, dus ook sluiten van Outlook en daarna weer automatisch laten opstarten van Outlook. Wat bedoel je met Late Binding?

In het form_Load stond nog een On Error Resume dat de werkelijke situatie verdoezelde. Deze heb ik uitgeschakeld. De volgende situatie is ontstaan:

Als Outlook reeds is geopend, dan wordt met de knop181 de volgende foutmelding in regel <Set currentExplorer = Applicatie.ActiveExplorer> melding: <Fout 424 - Object vereist>.
Als Outlook niet is geopend, dan wordt met de knop de foutmelding in regel <Set oOutlook = GetObject(, "Outlook.Application")> medling: < Fout 429 - AxtiveX kan geen object maken>.

Een map uitlezen is voor de gebruiker omslachtig, vergt meer handelingen en daarmee is het nut van de automatisering weg. Volgens mij zou ik dezelfde foutmeldingen krijgen, Outlook wordt nmi. niet gedetecteerd. Ik hoop op een goede tip voor een oplossing.

Code:
Private Sub Form_Load()                                         'Formulier Bijlagen wordt gestart 
    
Dim oOutlook As Object
    If Not Me.OpenArgs = vbNullString Then Me.Bijlagen_ID = Me.OpenArgs 'Overnemen Bijlagen ID
 
                   'On Error Resume Next
    Set oOutlook = GetObject(, "Outlook.Application")           'Outlook starten indien deze niet is geopend
                  'On Error GoTo 0

    If oOutlook Is Nothing Then
        Shell ("OUTLOOK")
    End If
End Sub
Code:
Private Sub Knop181_Click()                         'In formulier Bijlagen knop Automatisch Bijlagen email opslaan

Dim currentExplorer As Outlook.Explorer
Dim Selection As Selection
Dim obj As Object, att As Object
Dim Ext As String

    Set currentExplorer = Applicatie.ActiveExplorer           'Af en toe een foutmelding op deze regel
    Set Selection = currentExplorer.Selection
    For Each obj In Selection
        With obj
            If .Attachments.Count > 0 Then
                For Each att In .Attachments
                    Ext = Right(att.Filename, 4)
                    Select Case Ext
                        Case ".pdf", ".xls", "xlsx", ".doc", "docx", ".jpg", "jpeg", ".png", ".msg"
                            att.SaveAsFile "D:\Bijlagen_email_db\" & att.Filename
                    End Select
                Next att
            Else
                MsgBox "Er zijn geen bijlagen in de email"
            End If
       End With
 
Laatst bewerkt:
Late Binding is een techniek waarbij je geen bibliotheken nodig hebt; je roept a.h.w. de benodigde elementen op wanneer je ze nodig hebt, die je dan eerst als Object declareert. Dat is handig als je een procedure hebt die op meerdere computers draait, al helemaal als dat Db’s zijn op verschillende Office versies. Je hoedt dan niet te checken of de bibliotheken wel geladen zijn. Access pakt dan zelf namelijk de juiste bibliotheek.

Weet je op voorhand met welke versie je werkt, dan is Early Binding een veel betere optie. Niet alleen werkt het sneller, je kunt ook nog eens IntelliSense gebruiken. Maar vooral de snelheidswinst is in jouw geval denk ik een doorslaggevende reden om dus Early Binding te gaan gebruiken.
 
Weer wat geleerd, dank. We werkten in de snelle reacties langs elkaar heen en heb mijn bericht aangepast. Zie svp bericht #7.
 
Na weer dagen stoeien en zoeken de volgende resultaten. Ik heb alle code ondergebracht onder de knop181 (Bijlagen email opslaan)
Code:
Private Sub Knop181_Click()                         'In formulier Bijlagen knop Automatisch Bijlagen email opslaan
Dim ObjApp As Outlook.Application
Dim oOutlook As Object
Dim currentExplorer As Outlook.Explorer
Dim Selection As Selection
Dim obj As Object, att As Object
Dim Ext As String

On Error Resume Next
    Set oOutlook = GetObject(, "Outlook.Application")
' check for error 429, not open, create new instance
    If Err.Number <> 0 Then        ' = 429
        Err.Clear
        oOutlook.Close
        Set oOutlook = Nothing
        Set oOutlook = CreateObject("Outlook.application")
        Shell ("Outlook")                                                    'start Outlook
    End If
On Error GoTo 0

On Error Resume Next
        Set oOutlook = GetObject(, "Outlook.Application")   'Voor controle of Outlook opgestart is
On Error GoTo 0

    If oOutlook Is Nothing Then
        MsgBox "Outlook is niet geopend." & Chr(13) & Chr(10) & Chr(10) & "Start Outlook en voeg opnieuw de email bijlagen toe."
        DoCmd.Close               'Sluit het formulier en laat de gebruiker Outlook opstarten.
            Exit Sub                  'Exit forumlier email bijlagen indien Outlook niet is geopend
    End If

    MsgBox "Is de email geselecteerd?"

    Set ObjApp = Outlook.Application
    Set currentExplorer = ObjApp.ActiveExplorer    'FOUT Na 2x Outlook handmatig sluiten en door knop Outlook laten opstarten, op deze regel 'Fout 462 De externe servercomputer bestaat niet of is niet beschikbaar
    Set Selection = currentExplorer.Selection

    For Each obj In Selection
        With obj
            If .Attachments.Count > 0 Then
                For Each att In .Attachments
                    Ext = Right(att.Filename, 4)
                    Select Case Ext
                        Case ".pdf", ".xls", "xlsx", ".doc", "docx", ".jpg", "jpeg", ".png", ".msg"
                            att.SaveAsFile "D:\Bijlagen_email_db\" & att.Filename
                    End Select
                Next att
            Else
                MsgBox "Er zijn geen bijlagen in de email"
            End If
       End With
    Next obj
    
         Set oOutlook = Nothing
         Set ObjApp = Nothing
         Set currentExplorer = Nothing
         Set obj = Nothing
End Sub

Als ik Outlook steeds sluit en de knop181 activeer, dan wordt na een tweede poging de foutmelding 462 getoond ondanks dat in regel < Set oOutlook = GetObject(, "Outlook.Application") 'Voor controle of Outlook opgestart is> is geconstateerd, dat Outlook door de code is opgestart. De foutmelding is: De externe servercomputer bestaat niet of is niet beschikbaar in regel < Set currentExplorer = [UObjApp.]Application.[/U]ActiveExplorer >
Dit blijkt bij MS een bekend effect te zijn. In de achtergrond schijnt een verborgen Global variabele te draaien, die bij het sluiten van de module moet worden gestopt, maar hoe?? Zie:
HTML:
https://support.microsoft.com/en-us/help/189618/you-may-receive-the-run-time-error-2147023174-800706ba-error-message-o

Wie kan mij svp. helpen? Het probleem is zeer hardnekkig. Als dit niet gaat draaien, dan is de functie onbetrouwbaar en niet bruikbaar. Hoe los ik het op. Bijvoorbaat mijn dank voor het meedenken.
 
Laatst bewerkt:
Ik snap eerlijk gezegd niet dat je het probleem niet vanuit Outlook oplost; de gebruiker moet sowieso een mail in Outlook hebben geselecteerd (of moet er één selecteren) dus je hebt Outlook altijd open staan. Wat is er makkelijker dan vanuit je mail programma op de knop te drukken, de bijlagen op te slaan en de verwijzing naar de bestanden op te slaan in je database. Dat kan heel simpel met een Recordset en een Insert opdracht. Trekt heel wat minder resources en wachttijden overhoop :).
 
Dank voor je reactie. Nu doen we het al zo vanuit Outlook maar vanwege de zeer vele bijlagen (per mail tot 10) en emails per dag zou meer automatisering welkom zijn. Alle bijlagen worden op de server opgeslagen, dus kopiëren en plakken, vervolgens wordt de verwijzing in de db (Bijlagen formulier) uitgevoerd en daarna de emails in aparte mappen opgeslagen. Dan moeten er ook nog losse bijlagen en documenten in de db en de server (cloud) worden opgeslagen. Alle verzamelde opgeslagen bijlagen in de db worden van een specifiek nummer voorzien. Soms tot 26 bijlagen per werk, opdrachten, foto's, documenten, facturen, bonnen, orders, etc. . Dat zou straks dan automatisch gaan gebeuren. Kortom veel werk waarbij ook fouten worden gemaakt. Ik sta er ook van te kijken, doe het belangeloos en een uitdaging om de access puzzels op te lossen.
Wat ik zou willen, is de bijlagen in de email en de email zelf, automatisch op de server plaatsen, autm. van een nummer voorzien en een autm. verwijzing in de db. De eerste stap is de bijlagen uit de emails opslaan en dat is grotendeels gelukt. Helaas een hardnekkige foutmelding 462. Als dat kan worden opgelost, dan zou dat geweldig zijn. Hoe los ik het met jullie gewaardeerde hulp op?
 
Laatst bewerkt:
Ik snap steeds minder van je vraag; je begon zo:
Van slechts steeds één door de gebruiker geselecteerde c.q. geopende email wil ik na een druk op de formulier knop de bijlage(n) van deze email opslaan op de hd. In een verder stadium wil ik deze als bijlage opslaan in de db.
Daarmee geef je aan de je vanuit de gebruiker een door hem/haar geopende/geslecteerde mail wil kunnen verwerken. Dat gaat, vanuit die gebruiker, perfect met een routine die je onder een knop hangt.
Nu zeg je echter:

Nu doen we het al zo vanuit Outlook maar vanwege de zeer vele bijlagen (per mail 10) en emails per dag zou meer automatisering welkom zijn. Alle bijlagen worden op de server opgeslagen, .. vervolgens wordt de verwijzing in de db .. uitgevoerd en daarna de emails in aparte mappen opgeslagen. .. Wat ik zou willen, is de bijlagen in de email en de email zelf automatisch op de server plaatsen, van een nummer voorzien en een verwijzing in de db.
Dat is een héél ander probleem. En één die je dus prima vanuit Outlook kan oplossen. Je kunt in Outlook een functie maken die alle mails bij binnenkomst scant, de bijlagen opslaat en de mail in de betreffende map zet. Dat laatste moet dan wél op basis van een herkenbaar gegeven, zoals een vaste afzender, of een projectcode die in het onderwerp staat. De code die jij steeds laat zien opent en sluit Outlook elke keer als je op de knop drukt. Nogal omslachtig, en vooral: volslagen overbodig. Kies een werkwijze die het handigst is bij het juiste pakket :). Mijn werkwijze zou dus zijn om de mails vanuit Outlook te verwerken, en niet vanuit Access.
 
Dank OctaFish. Dankzij jullie hulp met de ontwikkeling neemt de Access applicatie nu al veel werk uit handen en deze zou ik willen volmaken. Je zou de applicatie een keer moeten zien. Om van Outlook de bijlagen op te slaan beschikken we niet over een vast gegeven om bv. een regel in te stellen, de emails zijn zeer divers van aard. Als ze in een map worden geplaatst moeten daarna nog verschillende handelingen handmatig worden uitgevoerd. De handmatige handelingen (ca. 25.000 bijlagen per jaar) die nu worden uitgevoerd, worden soms ook met fouten (documenten niet in de mappen en in verkeerde mappen) uitgevoerd. Automatisering zou erg goed uitkomen en met de knop oplossing werkt dat nu al deels goed.

Na het drukken van de knop, opent Outlook en blijft staan, ook als ik het bijlagen formulier sluit. De knop werkt goed, maar als de gebruiker zelf Outlook een keer sluit en daarna de knop voor het opslaan van bijlagen drukt, start Outlook weer. Outlook is dus actief, (positief resultaat met controle GetObject …. en If oOutlook Is Nothing Then), maar wordt ondanks in de regel: <Set currentExplorer = ObjApp.Application.ActiveExplorer> niet herkent en geeft in deze regel de foutmelding 462 dat de server niet beschikbaar is. Voor MS een bekende fout (zie / lees item Url).
Ik begrijp de uitleg van MS (voorbeeld in Word) niet, kan daardoor de situatie niet vertalen naar de Outlook situatie en weet dus niet wat ik kan doen. Op internet vind je vele issues met dezelfde problemen. Ik weet niet hoe ik het kan oplossen, svp. hulp.
 
Laatst bewerkt:
Outlook is dus actief, (positief resultaat met controle GetObject …. en If oOutlook Is Nothing Then), maar wordt ondanks in de regel: <Set currentExplorer = ObjApp.Application.ActiveExplorer> niet herkent en geeft in deze regel de foutmelding 462 dat de server niet beschikbaar is.

Haal je Outlook en ActiveExplorer nu niet door elkaar ?
 
Nee, volgens mij niet. Met Explorer wordt nmi niet Windows Verkenner bedoeld als je dat bedoeld.
 
kijk eens op Youtube


Outlook VBA - Save mail attachments to your local drive based on selected emails

komt aardig overeen.
 
Dank Pletter. Ik heb de Youtube uitleg gezien. Het is een hele nieuwe code die in oorsprong hetzelfde doet als de mijne. Error 462 wordt niet behandeld. De selectie en het opslaan gaan goed (de functies werken goed) echter als ik Outlook sluit en mbv de code automatisch laat opstarten wordt de foutmelding 462 gegeven. Het is een bekend verschijnsel bij Microsoft. Ik begrijp de uitleg van MS ongeveer maar ben niet in staat mijn code aan te passen tot een oplossing. Wat te doen?
 
Heb zelf geen outlook in gebruik, dus kan het ook niet testen.

Verander deze regel Set olSelection = ActiveExplorer.Selection

in de youtube oplossing in:

Set olSelection = New ActiveExplorer.Selection

Is maar een gok.
 
Dank Pletter. Selection is een Variabele en met Ol er voor veranderd alleen de naam van de variabele en niet de functie er van. Er schijnt in Access een global variabele in de achtergrond actief te zijn die door Access in dienst wordt gesteld als iets in de code niet goed wordt aangestuurd. En dat is net het mankement wat ik mis, iets? Outlook is actief maar wordt niet herkend door Access, dat komt door de variabele. Hopelijk hebben OctaFish, Edmoor of SNB ook een suggestie. Graag aandacht voor de items #10, #12 en #14.
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan