Ik gebruik Micr. Outlook en heb een persoonlijke map aangemaakt met de naam Persoonlijke map (ik heb dus 2 inboxen enz.)
Nou gebruik ik een script voor het controleren van binnengekomen emails, nu wil ik dat hij alleen de inbox van de persoonlijke map naloopt, iemand een idee?
Sub email_controleren()
DoEvents 'Geef control aan Windows
' On Error GoTo OutlookNotStarted 'Spring bij het optreden van een fout naar error routine
Set OLApp = CreateObject("Outlook.Application") 'Creeer een Outlook Applicatie
Set mNameSpace = OLApp.GetNamespace("MAPI") 'Leg koppeling naar Outlook MAPI
Set AllMessages = mNameSpace.GetDefaultFolder(olFolderInbox).Items 'Lees alle berichten uit Postvakin en plaats deze in lijst
For intSelectedentry = 1 To AllMessages.Count Step 1 'Begin bij het eerste bericht
Set Thismessage = AllMessages.Item(intSelectedentry) 'Plaats het eerste bericht in Thismessage
Set MessageAttachments = Thismessage.Attachments 'Plaats de Attachments in MessageAttachments
For Each thisattachment In MessageAttachments 'Zoek iedere Attachment binnen MessageAttachment
With Thismessage
If .UnRead = True Then
' MsgBox "Gevonden Attachment " & thisAttachment.FileName & _
' " wordt opgeslagen!", vbInformation 'Geef melding op scherm welke Attachment is geselecteerd
DoEvents 'Geef control aan Systeem
msgbox("er is een email opgeslagen!")
'Het wegschrijven van een Attachment kan enige tijd duren
'Hier moet dus nog een bewaking komen dat de Attachment allemaal zijn weggeschreven
'Er wordt niet getest of de files reeds bestaat en overschreven noet worden
'Voeg zelfcode toe om dit te kunnen
.UnRead = False
End If
End With
Next 'Haal volgende Attachment op
Next intSelectedentry 'Haal volgende E-mail op
MsgBox "Alle E-mail berichten zijn verwerkt en alle gevonden Attachments zijn opgeslagen", vbExclamation
Set OLApp = Nothing 'Ontkoppel OLAapp
Exit Sub
OutlookNotStarted:
MsgBox "Outlook kan niet gestart worden.", vbInformation 'Genereer foutmelding dat Outlook niet gestart kan worden
Exit Sub
NoMAPINameSpace:
MsgBox "Could not get MAPI NameSpace", vbInformation 'Genereer foutmelding dat de MAPI niet bereikt kan worden
Exit Sub
End Sub
Nou gebruik ik een script voor het controleren van binnengekomen emails, nu wil ik dat hij alleen de inbox van de persoonlijke map naloopt, iemand een idee?
Sub email_controleren()
DoEvents 'Geef control aan Windows
' On Error GoTo OutlookNotStarted 'Spring bij het optreden van een fout naar error routine
Set OLApp = CreateObject("Outlook.Application") 'Creeer een Outlook Applicatie
Set mNameSpace = OLApp.GetNamespace("MAPI") 'Leg koppeling naar Outlook MAPI
Set AllMessages = mNameSpace.GetDefaultFolder(olFolderInbox).Items 'Lees alle berichten uit Postvakin en plaats deze in lijst
For intSelectedentry = 1 To AllMessages.Count Step 1 'Begin bij het eerste bericht
Set Thismessage = AllMessages.Item(intSelectedentry) 'Plaats het eerste bericht in Thismessage
Set MessageAttachments = Thismessage.Attachments 'Plaats de Attachments in MessageAttachments
For Each thisattachment In MessageAttachments 'Zoek iedere Attachment binnen MessageAttachment
With Thismessage
If .UnRead = True Then
' MsgBox "Gevonden Attachment " & thisAttachment.FileName & _
' " wordt opgeslagen!", vbInformation 'Geef melding op scherm welke Attachment is geselecteerd
DoEvents 'Geef control aan Systeem
msgbox("er is een email opgeslagen!")
'Het wegschrijven van een Attachment kan enige tijd duren
'Hier moet dus nog een bewaking komen dat de Attachment allemaal zijn weggeschreven
'Er wordt niet getest of de files reeds bestaat en overschreven noet worden
'Voeg zelfcode toe om dit te kunnen
.UnRead = False
End If
End With
Next 'Haal volgende Attachment op
Next intSelectedentry 'Haal volgende E-mail op
MsgBox "Alle E-mail berichten zijn verwerkt en alle gevonden Attachments zijn opgeslagen", vbExclamation
Set OLApp = Nothing 'Ontkoppel OLAapp
Exit Sub
OutlookNotStarted:
MsgBox "Outlook kan niet gestart worden.", vbInformation 'Genereer foutmelding dat Outlook niet gestart kan worden
Exit Sub
NoMAPINameSpace:
MsgBox "Could not get MAPI NameSpace", vbInformation 'Genereer foutmelding dat de MAPI niet bereikt kan worden
Exit Sub
End Sub
