Outlook instructions from other programs





example file


Access to Outlook

VBA contains 3 methods to gain access to Outlook from another program

I. Outlook hasn't been loaded: the method CreateObject

with CreateObject("Outlook.Application")
x=.GetNamespace("MAPI").GetDefaultFolder(6).Items.count
End With

Restriction:
'CreateObject' doesn't recognize Outlook typenames, only Outlookconstants.
E.g. the typename of map 'PostIN' is in VBA olFolderInbox; the Outlookconstant for this map is 6.

x=CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Items.count
Returns an error.

II. Outlook has been loaded: the method Getobject

With Getobject(,"Outlook.Application")
x=.GetNamespace("MAPI").GetDefaultFolder(6).Items.Count
End With
The method 'GetObject' has the same restrictions to typenames as the method 'CreateObject'.

III. Load the Outlook-VBA-library

   the method 'references': independent whether Outlook has been loaded or not.
   manually: VBEditor/ MenuBar / Extra / References / Microsoft Outlook 11.0 Object Library /check
sub referentie()
ThisWorkbook.VBProject.References.AddFromFile "msoutl9.olb"   ' Outlook 2000
ThisWorkbook.VBProject.References.AddFromFile "msoutl10.olb"   ' Outlook 2003
ThisWorkbook.VBProject.References.AddFromFile "msoutl11.olb"   ' Outlook 2007
End sub
   after the library has been loaded you can use outlook as an object
with Outlook
x=.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Items.Count
end with
   In this case you can use both Outlook's typenames and Outlookconstants.

The examples in this page use the Method 'CreateObject'.

Defaultfolder in Outlook

Inventory defautfolders

Sub mappen_defaultmappen()
With CreateObject("Outlook.Application").GetNamespace("MAPI")
c01 = .GetDefaultFolder(3).Name   '    Verwijderde items    (olFolderDeletedItems)
c02 = .GetDefaultFolder(4).Name   '    PostOUT    (olFolderOutbox)
c03 = .GetDefaultFolder(5).Name   '    Sent items    (olFolderSentItems)
c04 = .GetDefaultFolder(6).Name   '    PostIN    (olFolderInbox)
c05 = .GetDefaultFolder(9).Name   '    Calendar    (olFolderCalendar)
c06 = .GetDefaultFolder(10).Name   '    Contacts    (olfolderContacts)
c07 = .GetDefaultFolder(11).Name   '    Journal    (olFolderJournal)
c08 = .GetDefaultFolder(12).Name   '    Notes    (olFolderNotes)
c09 = .GetDefaultFolder(13).Name   '    Tasks    (olFolderTasks)
c10 = .GetDefaultFolder(14).Name   '    Reminders
c11 = .GetDefaultFolder(15).Name   '    Reminders
c12 = .GetDefaultFolder(16).Name   '    Drafts    (olFolderDrafts)
End With
End Sub

Standarditems in Outlook

   Outlook has a number of standard items
   - email
   - appointment
   - contact
   - task
   - journal
   - note
   - 'sticker' (Post-it)
   - distributionlist

   some items are connected items like
   - taskrequest
   - meetingrequest

   Outlook distinguishes emails according to the folder they are being stored in:
   - draft email :        in folder Drafts               GetDefaultFolder(16)
   - email :                      in map PostOUT             GetDefaultFolder(4)
   - sent email :    in map Sent items      GetDefaultFolder(5)
   - received email :    in map PostIN                GetDefaultFolder(6)

Inventory standard items

Sub items_standaarditems()
With CreateObject("Outlook.Application")
.CreateItem(0)   '    email                   (olMailItem)
.CreateItem(1)   '    appointment              (olAppointmentItem)
.CreateItem(2)   '    contact/recipient    (olContactItem)
.CreateItem(3)   '    task                    (olTaskItem)
.CreateItem(4)   '    journal              (olJournalItem)
.CreateItem(5)   '    note                (olNoteItem)
.CreateItem(6)   '    sticker               (olPostItem)
.CreateItem(7)   '    distributionlist     (olDistributionListItem)
End With
End Sub

VBA commands in Outlook

   For every kind of outlookitem all properties will be shown in VBA

   For every kind of outlookitem then most common actions will be discussed:

   - to make a new item
   - to read, adapt, move or delete an exisiting item
   - to filter existing items and read, adapt, move or delete those filtered items
   - to search existing items and read, adapt, move or delete the found item(s)

Email

Email properties

Sub email__eigenschappen()
With CreateObject("Outlook.application").GetNamespace("MAPI").GetDefaultFolder(6).Items(1)
c0 = .Actions.Count
For Each ac In .Actions
d01 = ac.Application
d02 = ac.Class
d03 = ac.CopyLike
d04 = ac.Enabled   ' True / False
d05 = ac.MessageClass
d06 = ac.Name
d07 = ac.Parent
d08 = ac.prefix
d09 = ac.ReplyStyle
d010 = ac.ResponseStyle
d011 = ac.Session
d012 = ac.ShowOn
Next
c01 = .AlternateRecipientAllowed   ' True / False
c02 = .Application
c03 = .Attachments.Count   ' number of attachments
c04 = .AutoForwarded   ' True / False
c05 = .BCC   ' BlindCopy recipients
c06 = .BillingInformation
c07 = .body   ' content
c08 = .Categories
c09 = .CC   ' Copy Recipients
c010 = .Class
c011 = .Companies
c012 = .ConversationIndex
c013 = .ConversationTopic
c014 = .CreationTime
c015 = .DeferredDeliveryTime
c016 = .DeleteAfterSubmit   ' True / False
c017 = .entryId
c018 = .ExpiryTime
c019 = .FlagDueBy
c020 = .FlagRequest
c021 = .FlagStatus
C022 = .FormDescription
c023 = .GetInspector
c024 = .HTMLBody
c025 = .Importance
c026 = .LastModificationTime
c027 = .links.Count
c028 = .MessageClass
c029 = .Mileage
c030 = .NoAging   ' True / False
c031 = .OriginatorDeliveryReportRequested   ' True / False
c032 = .OutlookInternalVersion
c033 = .OutlookVersion
c034 = .Parent
c035 = .ReadReceiptRequested   ' True / False
c036 = .ReceivedByEntryID
c037 = .ReceivedByName
c038 = .ReceivedOnBehalfOfEntryID
c039 = .ReceivedOnBehalfOfName
c040 = .ReceivedTime
c041 = .RecipientReassignmentProhibited   ' True / False
c042 = .Recipients.Count
For Each rp In .Recipients
d01 = rp.Name
d02 = rp.address
d03 = rp.Name
Next
c043 = .ReminderOverrideDefault   ' True / False
c044 = .ReminderPlaySound   ' True / False
c045 = .ReminderSet   ' True / False
c046 = .ReminderSoundFile
c047 = .ReminderTime
c048 = .RemoteStatus
c049 = .ReplyRecipientNames
c050 = .ReplyRecipients.Count
c051 = .Saved   ' True / False
c052 = .SaveSentMessageFolder
c053 = .SenderName
c054 = .Sensitivity
c055 = .Sent   ' True / False
c056 = .SentOn
c057 = .sentonbehalfofname
c058 = .Session
c059 = .Size
c060 = .subject
c061 = .Submitted   ' True / False
c062 = .To
c063 = .UnRead   ' True / False
c064 = .UserProperties.Count
c065 = .VotingOptions
c066 = .VotingResponse
End With
End Sub

Email-drafts

   Email-drafts are the result of 'Save' when making a new email.
   The post will be stored automatically in the folder 'Drafts': GetDefaultFolder(16).

New email draft

Sub email_concept_nieuw()
With CreateObject("Outlook.Application").CreateItem(0)
.Subject = "controle"
.To = "snb@forum.eu"
.Save
End With
End Sub

New email draft to several addresses

Sub email_concept_nieuw_meer_adressen()
With CreateObject("Outlook.Application").CreateItem(0)
.subject = "controle"
.To = "snb@forum.eu;bb@gmail.com;extra@planet.nl"
.Save
End With
End Sub

New email draft to several CC-addresses

Sub email_concept_nieuw_meer_CCadressen()
With CreateObject("Outlook.Application").CreateItem(0)
.subject = "controle"
.To = "snb@forum.eu"
.CC = "aaa@webforums.eu;bb@gmail.com;extra@planet.nl"
.Save
End With
End Sub

New email draft to several BCC-addresses

Sub email_concept_nieuw_meer_BCCadressen()
With CreateObject("Outlook.Application").CreateItem(0)
.subject = "controle"
.To = "snb@forum.eu"
.BCC = "aaa@webforums.eu;bb@gmail.com;extra@planet.nl"
.Save
End With
End Sub

New email draft add recipients

         The methode Recipients.Add can only be aplied to existing contacts in the folder Contacts.
Sub email_concept_nieuw_recipients_To_toevoegen()
With CreateObject("Outlook.Application").CreateItem(0)
.subject = "controle"
.To = "snb@forum.eu"
.Recipients.Add "aaa@webforums.eu;bb@gmail.com;extra"
.Save
End With
End Sub

New email draft add CC recipients

Sub email_concept_nieuw_recipients_CC_toevoegen()
With CreateObject("Outlook.Application").CreateItem(0)
.subject = "controle"
.To = "snb@forum.eu"
.Recipients.Add("aaa@webforums.eu;bb@gmail.com;extra").Type = 4
.Save
End With
End Sub

New email draft add BCC recipients

Sub email_concept_nieuw_recipients_BCC_toevoegen()
With CreateObject("Outlook.Application").CreateItem(0)
.subject = "controle"
.To = "snb@forum.eu"
.Recipients.Add("aaa@webforums.eu;bb@gmail.com;extra").Type = 3
.Save
End With
End Sub

New email draft add attachments

Sub email_concept_attachments_toevoegen()
With CreateObject("Outlook.Application").CreateItem(0)
.subject = "controle"
.To = "aaa@webforums.eu"
.attachments.add "E:\OF\bestand1.xls"
.attachments.add "E:\OF\bestand2.xls"
.Save
End With
End Sub

Email draft: read

Sub email_concept_lezen()
c00 = "controle"                        '   you can refer to a email draft by it's 'subject'.

With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(16).Items(c00)
c01 = .To
c02 = .subject
c03 = .body
End With
End Sub

Email draft: move to another folder

Sub email_concept_verplaatsen()
c00 = "controle"

With CreateObject("Outlook.Application").GetNamespace("MAPI")
.GetDefaultFolder(16).Items(c00).Move .GetDefaultFolder(3)
End With
End Sub

Email draft: delete

Sub email_concept_verwijderen()
c00 = "controle"

CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(16).Items(c00).Delete
End Sub

Email draft: adapt

Sub email_concept_wijzigen()
c00 = "controle"

CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(16).Items(c00).subject = "new subject"
End Sub
If you want to apply code to several items you can use the 'Filter' method or the 'Find' method

Email drafts: filter and read

Sub email_concepten_filteren_lezen()
c00 = "controle"

For Each it InCreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(16).Items.Restrict("[Subject]='" & c00 & "'")
c01 = c01 & "|" & it.body
Next
End Sub

Email drafts: filter and move to another folder

Sub email_concepten_filteren_verplaatsen()
c00 = "controle"

With CreateObject("Outlook.Application").GetNamespace("MAPI")
For Each it In .GetDefaultFolder(16).Items.Restrict("[Subject]='" & c00 & "'")
it.Move .GetDefaultFolder(3)
Next
End With
End Sub

Email drafts: filter and delete

Sub email_concepten_filteren_verwijderen()
c00 = "controle"

For Each it In CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(16).Items.Restrict("[Subject]='" & c00 & "'")
it.Delete
Next
End Sub

Email drafts: filter and adapt

Sub email_concepten_filteren_wijzigen()
c00 = "controle"
c01 = "new subject"

For Each it In CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(16).Items.Restrict("[Subject]='" & c00 & "'")
With it
.subject = c01
.Save
End With
Next
End Sub

Email draft: find and read

Sub email_concepten_zoeken_lezen()
On Error Resume Next

c00 = "controle"

With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(16).Items
c01 = .Find("[Subject]='" & c00 & "'").body
Do Until Err.Number <>0
c01 = c01 & "|" & .FindNext.body
Loop
End With
End Sub

Email drafts: find and move to another folder

Sub email_concepten_zoeken_verplaatsen()
On Error Resume Next

c00 = "controle"

With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(16).Items
.Find("[Subject]='" & c00 & "'").Move .Application.GetNamespace("MAPI").GetDefaultFolder(3)
Do Until Err.Number <>0
.FindNext.Move .Application.GetNamespace("MAPI").GetDefaultFolder(3)
Loop
End With
End Sub

Email drafts find and delete

Sub email_concepten_zoeken_verwijderen()
On Error Resume Next

c00 = "controle"

With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(16).Items
.Find("[Subject]='" & c00 & "'").Delete
Do Until Err.Number <>0
.FindNext.Delete
Loop
End With
End Sub

Email drafts find and adapt

Sub email_concepten_zoeken_wijzigen()
On Error Resume Next

c00 = "controle"
c01 = "new subject"

With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(16).Items
With .Find("[Subject]='" & c00 & "'")
.subject = c01
.Save
End With

Do Until Err.Number <>0
With .FindNext
.subject = c01
.Save
End With
Loop
End With
End Sub

Emails in folder PostOUT

Emails are the result of 'Send' when making a new email.
They will be stored automatically in the folder PostOUT: GetDefaultFolder(4).

New email

Sub email_nieuw()
With CreateObject("Outlook.Application").CreateItem(0)
.To = "snb@webforums.eu"
.subject = "controle"
.body = "bodytext"
.send
End With
End Sub

New email with HTML

Sub email_nieuw_html()
With CreateObject("Outlook.Application").CreateItem(0)
.To = "snb@webforum.eu"
.subject = "controle blusser A230"
.HTMLBody = "<'a href=""http://office.webforums.eu/"">Office forum"
.Save
End With
End Sub

Email read

You can find an email using it's 'subject'
Sub email_read()
c00 = "controle"

c01= CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(4).Items(c00).body
End Sub

Email move to another folder

Sub email_verplaatsen()
c00 = "controle"

With CreateObject("Outlook.Application").GetNamespace("MAPI")
.GetDefaultFolder(4).Items(c00).Move .GetDefaultFolder(16)
End With
End Sub

Email delete

Sub email_verwijderen()
c00 = "controle"

CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(4).Items(c00).Delete
End Sub

Email adapt

Sub email_wijzigen()
c00 = "controle"

CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(4).Items(c00).subject = "new subject"
End Sub

Emails: filter and read

Sub emails_filteren_lezen()
c00 = "controle"

For Each it In CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(4).Items.Restrict("[Subject]='" & c00 & "'")
c01 = c01 & "|" & it.body
Next
End Sub

Emails: filter and move to another folder

Sub emails_filteren_verplaatsen()
c00 = "controle"

For Each it In CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(4).Items.Restrict("[Subject]='" & c00 & "'")
it.Move .application.getnamespace("MAPI").GetDefaultFolder(16)
Next
End Sub

Emails: filter and delete

Sub emails_filteren_verwijderen()
c00 = "controle"

For Each it In CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(4).Items.Restrict("[Subject]='" & c00 & "'")
it.Delete
Next
End Sub

Emails: filter and adapt

Sub emails_filteren_wijzigen()
c00 = "controle"
c01 = "new subject"

For Each it In CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(4).Items.Restrict("[Subject]='" & c00 & "'")
With it
.subject = c01
.Save
end with
Next
End Sub

Emails: find and read

Sub emails_zoeken_lezen()
On Error Resume Next

c00 = "controle"

With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(4).Items
c01 = .Find("[Subject]='" & c00 & "'").body
Do Until Err.Number <>0
c01 = c01 & "|" & .FindNext.body
Loop
End With
End Sub

Emails: find and move to another folder

Sub emails_zoeken_verplaatsen()
On Error Resume Next

c00 = "controle"

With CreateObject("Outlook.Application").GetNamespace("MAPI")
.GetDefaultFolder(4).Items.Find("[Subject]='" & c00 & "'").Move .GetDefaultFolder(16)
Do Until Err.Number <>0
.GetDefaultFolder(4).Items.FindNext.Move .GetDefaultFolder(16)
Loop
End With
End Sub

Emails: find and delete

Sub emails_zoeken_verwijderen()
On Error Resume Next

c00 = "controle"

With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(4).Items
.Find("[Subject]='" & c00 & "'").Delete
Do Until Err.Number <>0
.FindNext.Delete
Loop
End With
End Sub

Emails: find and adapt

Sub emails_zoeken_wijzigen()
On Error Resume Next

c00 = "controle"
c01 = "new subject"

With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(4).Items
With .Find("[Subject]='" & c00 & "'")
.subject = c01
.Save
End With

Do Until Err.Number <>0
With .FindNext
.subject = c01
.Save
End With
Loop
End With
End Sub

Sent emails

   The folder 'Sent emails' is the result of the sending of all items in folder PostOUT to the mailserver.
   All items will be moved automatically to the folder Sent: GetDefaultFolder(5).

Sent email: read

Sub email_verzonden_lezen()
c00 = "controle"

With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(5).Items(c00)
c01 = .To & " " & .subject & " " & .body
End With
End Sub

Sent email: move to another folder

Sub email_verzonden_verplaatsen()
c00 = "controle"

With CreateObject("Outlook.Application").GetNamespace("MAPI")
.GetDefaultFolder(5).Items(c00).Move .GetDefaultFolder(3)
End With
End Sub

Sent email: delete

Sub email_verzonden_verwijderen()
c00 = "controle"

CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(5).Items(c00).Delete
End Sub

Sent email: adapt

Sub email_verzonden_wijzigen()
c00 = "controle"

CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(5).Items(c00).subject = "new subject"
End Sub

Sent Emails: filter and read

Sub emails_verzonden_filteren_lezen()
c00 = "controle"

For Each it In CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(5).Items.Restrict("[Subject]='" & c00 & "'")
c01 = c01 & "|" & it.body
Next
End Sub

Sent Emails: filter and move to another folder

Sub emails_verzonden_filteren_verplaatsen()
c00 = "controle"

With CreateObject("Outlook.Application").GetNamespace("MAPI")
For Each it In .GetDefaultFolder(5).Items.Restrict("[Subject]='" & c00 & "'")
it.Move .GetDefaultFolder(3)
Next
End With
End Sub

Sent emails: delete using a loop

Sub email_verzonden_verwijderen()
For Each it In CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(5).Items
If it.subject = "controle" Then it.Delete
Next
End Sub

Sent Emails: filter and delete

Sub emails_verzonden_filteren_verwijderen()
c00 = "controle"

For Each it In CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(5).Items.Restrict("[Subject]='" & c00 & "'")
it.Delete
Next
End Sub

Sent Emails: filter and adapt

Sub emails_verzonden_filteren_wijzigen()
c00 = "controle"
c01 = "new subject"

For Each it In CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(5).Items.Restrict("[Subject]='" & c00 & "'")
With it
.subject = c01
.Save
End With
Next End With
End Sub

Sent Emails: find and read

Sub emails_verzonden_zoeken_lezen()
On Error Resume Next

c00 = "controle"

With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(5).Items
c01 = .Find("[Subject]='" & c00 & "'").body
Do Until Err.Number <>0
c01 = c01 & "|" & .FindNext.body
Loop
End With
End Sub

Sent Emails: find and move to another folder

Sub emails_verzonden_zoeken_verplaatsen()
On Error Resume Next

c00 = "controle"

With CreateObject("Outlook.Application").GetNamespace("MAPI")
.GetDefaultFolder(5).Items.Find("[Subject]='" & c00 & "'").Move .GetDefaultFolder(3)
Do Until Err.Number <>0
.GetDefaultFolder(5).Items.FindNext.Move .GetDefaultFolder(3)
Loop
End With
End Sub

Sent Emails: find and delete

Sub emails_verzonden_zoeken_verwijderen()
On Error Resume Next

c00 = "controle"

With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(5).Items
.Find("[Subject]='" & c00 & "'").Delete
Do Until Err.Number <>0
.FindNext.Delete
Loop
End With
End Sub

Sent Emails: find and adapt

Sub emails_verzonden_zoeken_wijzigen()
On Error Resume Next

c00 = "controle"
c01 = "new subject"

With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(5).Items
With .Find("[Subject]='" & c00 & "'")
.subject = c01
.Save
End With

Do Until Err.Number <>0
With .FindNext
.subject = c01
.Save
End With
Loop
End With
End Sub

Received emails

   Received emails are being stored automatically in folder PostIN: GetDefaultFolder(6).

Received email read

Sub email_ontvangen_lezen()
c00 = "controle"

With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(6).Items(c00)
c01 = .To & " " & .subject & " " & .body
End With
End Sub

Received email move to another folder

Sub email_ontvangen_verplaatsen()
c00 = "controle"

With CreateObject("Outlook.Application").GetNamespace("MAPI")
.GetDefaultFolder(6).Items(c00).Move .GetDefaultFolder(3)
End With
End Sub

Received email delete

Sub email_ontvangen_verwijderen()
c00 = "controle"

CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(6).Items(c00).Delete
End Sub

Received email adapt

Sub email_ontvangen_wijzigen()
c00 = "controle"

CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(6).Items(c00).subject = "new subject"
End Sub

Received Emails: filter and read

Sub emails_ontvangen_filteren_lezen()
c00 = "controle"

For Each it InWith CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(6).Items.Restrict("[Subject]='" & c00 & "'")
c01 = c01 & "|" & it.body
Next
End Sub

Received Emails: filter and move to another folder

Sub emails_ontvangen_filteren_verplaatsen()
c00 = "controle"

With CreateObject("Outlook.Application").GetNamespace("MAPI")
For Each it In .GetDefaultFolder(6).Items.Restrict("[Subject]='" & c00 & "'")
it.Move .GetDefaultFolder(3)
Next
End With
End Sub

Received Emails: filter and delete

Sub emails_ontvangen_filteren_verwijderen()
c00 = "controle"

For Each it In CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(6).Items.Restrict("[Subject]='" & c00 & "'")
it.Delete
Next
End Sub

Received Emails: filter and adapt

Sub emails_ontvangen_filteren_wijzigen()
c00 = "controle"
c01 = "new subject"

For Each it In CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(6).Items.Restrict("[Subject]='" & c00 & "'")
With it
.subject = c01
.Save
End With
Next End With
End Sub

Received Emails: find and read

Sub emails_ontvangen_zoeken_lezen()
On Error Resume Next

c00 = "controle"

With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(6).Items
c01 = .Find("[Subject]='" & c00 & "'").body
Do Until Err.Number <>0
c01 = c01 & "|" & .FindNext.body
Loop
End With
End Sub

Received Emails: find and move to another folder

Sub emails_ontvangen_zoeken_verplaatsen()
On Error Resume Next

c00 = "controle"

With CreateObject("Outlook.Application").GetNamespace("MAPI")
.GetDefaultFolder(6).Items.Find("[Subject]='" & c00 & "'").Move .GetDefaultFolder(3)
Do Until Err.Number <>0
.GetDefaultFolder(6).Items.FindNext.Move .GetDefaultFolder(3)
Loop
End With
End Sub

Received Emails: find and delete

Sub emails_ontvangen_zoeken_verwijderen()
On Error Resume Next

c00 = "controle"

With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(6).Items
.Find("[Subject]='" & c00 & "'").Delete
Do Until Err.Number <>0
.FindNext.Delete
Loop
End With
End Sub

Received Emails: find and adapt

Sub emails_ontvangen_zoeken_wijzigen()
On Error Resume Next

c00 = "controle"
c01 = "new subject"

With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(6).Items
With .Find("[Subject]='" & c00 & "'")
.subject = c01
.Save
End With

Do Until Err.Number <>0
With .FindNext
.subject = c01
.Save
End With
Loop
End With
End Sub

Contacts

Contactitem properties

Sub Contact_eigenschappen()
' CreateItem (olContactItem)
' CreateItem (2)
' GetDefaultFolder(olFolderContacts)
' GetDefaultFolder(10)
' GetDefaultfolder("Contactpersonen"

With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(10).Items(1)
c00 = .Account
c01 = .Actions.count
c02 = .Anniversary
c03 = .Application
c04 = .AssistantName
c05 = .AssistantTelephoneNumber
c06 = .Attachments.count
c07 = .BillingInformation
c08 = .Birthday
c09 = .body
c010 = .Business2TelephoneNumber
c011 = .BusinessAddress
c012 = .BusinessAddressCity
c013 = .BusinessAddressCountry
c014 = .BusinessAddressPostalCode
c015 = .BusinessAddressPostOfficeBox
c016 = .BusinessAddressState
c017 = .BusinessAddressStreet
c018 = .BusinessFaxNumber
c019 = .BusinessHomePage
c020 = .BusinessTelephoneNumber
c021 = .CallbackTelephoneNumber
C022 = .CarTelephoneNumber
c023 = .Categories
c024 = .children
c025 = .Class
c026 = .Companies
c027 = .CompanyAndFullName
c028 = .CompanyLastFirstNoSpace
c029 = .CompanyLastFirstSpaceOnly
c030 = .CompanyMainTelephoneNumber
c031 = .CompanyName
c032 = .ComputerNetworkName
c033 = .ConversationIndex
c034 = .ConversationTopic
c035 = .CreationTime
c036 = .CustomerID
c037 = .Department
c038 = .Email1Address
c039 = .Email1AddressType
c040 = .Email1DisplayName
c041 = .Email1EntryID
c042 = .Email2Address
c043 = .Email2AddressType
c044 = .Email2DisplayName
c045 = .Email2EntryID
c046 = .Email3Address
c047 = .Email3AddressType
c048 = .Email3DisplayName
c049 = .Email3EntryID
c050 = .entryId
c051 = .FileAs
c052 = .FirstName
c053 = .FormDescription
c054 = .FTPSite
c055 = .FullName
c056 = .FullNameAndCompany
c057 = .Gender
c058 = .GetInspector
c059 = .GovernmentIDNumber
c060 = .Hobby
c061 = .Home2TelephoneNumber
c062 = .HomeAddress
c063 = .HomeAddressCity
c064 = .HomeAddressCountry
c065 = .HomeAddressPostalcode
c066 = .HomeAddressPostOfficeBox
c067 = .HomeAddressState
c068 = .HomeAddressStreet
c069 = .HomeFaxNumber
c070 = .HomeTelephoneNumber
c071 = .Importance
c072 = .Initials
c073 = .InternetFreeBusyAddress
c074 = .ISDNNumber
c075 = .JobTitle
c076 = .Journal
c077 = .Language
c078 = .LastFirstAndSuffix
c079 = .LastFirstNoSpace
c080 = .LastFirstNoSpaceCompany
c081 = .LastFirstSpaceOnly
c082 = .LastFirstSpaceOnlyCompany
c083 = .LastModificationTime
c084 = .LastName
c085 = .LastNameAndFirstName
c086 = .Links.count
c087 = .MailingAddress
c088 = .MailingAddressCity
c089 = .MailingAddressCountry
c090 = .MailingAddressPostalCode
c091 = .MailingAddressPostOfficeBox
c092 = .MailingAddressState
c093 = .MailingAddressStreet
c094 = .ManagerName
c095 = .MessageClass
c096 = .MiddleName
c097 = .Mileage
c098 = .MobileTelephoneNumber
c099 = .NetMeetingAlias
c0100 = .NetMeetingServer
c0101 = .NickName
c0102 = .NoAging
c0103 = .OfficeLocation
c0104 = .OrganizationalIDNumber
c0105 = .OtherAddress
c0106 = .OtherAddressCity
c0107 = .OtherAddressCountry
c0108 = .OtherAddressPostalCode
c0109 = .OtherAddressPostOfficeBox
c0110 = .OtherAddressState
c0111 = .OtherAddressStreet
c0112 = .OtherFaxNumber
c0113 = .OtherTelephoneNumber
c0114 = .OutlookInternalVersion
c0115 = .OutlookVersion
c0116 = .PagerNumber
c0117 = .Parent
c0118 = .PersonalHomePage
c0119 = .PrimaryTelephoneNumber
c0120 = .Profession
c0121 = .RadioTelephoneNumber
c0122 = .ReferredBy
c0123 = .Saved
c0124 = .SelectedMailingAddress
c0125 = .Sensitivity
c0126 = .Session
c0127 = .Size
c0128 = .Spouse
c0129 = .subject
c0130 = .Suffix
c0131 = .TelexNumber
c0132 = .Title
c0133 = .TTYTDDTelephoneNumber
c0134 = .UnRead
c0135 = .User1
c0136 = .User2
c0137 = .User3
c0138 = .User4
c0139 = .UserCertificate
c0140 = .UserProperties.count
c0141 = .WebPage
c0142 = .YomiCompanyName
c0143 = .YomiFirstName
c0144 = .YomiLastName
End With
End Sub

New Contact

Sub Contact_nieuw()
With CreateObject("Outlook.Application").CreateItem(2)
.FirstName = "first"
.LastName = "last"
.Email1Address = "snb@forum.eu"
.Save
End With
End Sub

Contact read

Sub Contact_lezen()
c00 = "Jeroen Spoert"          ' = fullname

With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(10).Items(c00)
c01 = .FullName & "|" & .Email1Address
End With
End Sub

Contact information save as file

Sub Contact_opslaan_als()
c00 = "Jeroen Spoert"

With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(10).Items(c00)
.SaveAs "E:\" & .FullName & ".txt", 0
.SaveAs "E:\" & .FullName & ".rtf", 1
.SaveAs "E:\" & .FullName & ".oft", 2
.SaveAs "E:\" & .FullName & ".msg", 3
.SaveAs "E:\" & .FullName & ".vcf", 6
End With
End Sub

Contact move to another folder

Sub Contact_verplaatsen()
c00 = "Jeroen Spoert"

With CreateObject("Outlook.Application").GetNamespace("MAPI")
.GetDefaultFolder(10).Items(c00).Move .GetDefaultFolder(3)
End With
End Sub

Contact delete

Sub Contact_verwijderen()
c00 = "Jeroen Spoert"

CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(10).Items(c00).Delete
End Sub

Contact adapt

Sub Contact_wijzigen()
c00 = "Jeroen Spoert"

With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(10).Items(c00)
.Email2Address = "Jeroen@planeet.eu"
.Save
End With
End Sub

Contacts filter and read

Sub Contacts_filteren_lezen()
c00 = "Jeroen Spoert"

For Each it In CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(10).Items.Restrict("[Fullname]='" & c00 & "'")
c01 = c01 & "|" & it.Email1Address
Next
End Sub

Contacts filter and move to another folder

Sub Contacts_filteren_verplaatsen()
c00 = "Jeroen Spoert"

With CreateObject("Outlook.Application").GetNamespace("MAPI")
For Each it In .GetDefaultFolder(10).Items.Restrict("[FullName]='" & c00 & "'")
it.Move .GetDefaultFolder(3)
Next
End With
End Sub

Contacts filter and delete

Sub Contacts_filteren_verwijderen()
c00 = "Jeroen Spoert"

For Each it In CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(10).Items.Restrict("[FullName]='" & c00 & "'")
it.Delete
Next
End Sub

Contacts filter and adapt

Sub Contacts_filteren_wijzigen()
c00 = "Bedrijf1"
c01 = "Bedrijf1 BV."

For Each it In CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(10).Items.Restrict("[CompanyName]='" & c00 & "'")
With it
.CompanyName = c01
.Save
End With
Next
End Sub

Contacts find and read

Sub Contacts_zoeken_lezen()
On Error Resume Next

c00 = "Bedrijf1"

With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(10).Items
c01 = .Find("[CompanyName]='" & c00 & "'").FullName
Do Until Err.Number <>0
c01 = c01 & "|" & .FindNext.FullName
Loop
End With
End Sub

Contacts find and move to another folder

Sub Contacts_zoeken_verplaatsen()
On Error Resume Next

c00 = "Bedrijf1"

With CreateObject("Outlook.Application").GetNamespace("MAPI")
.GetDefaultFolder(10).Items.Find("[CompanyName]='" & c00 & "'").Move .GetDefaultFolder(3)
Do Until Err.Number <>0
.GetDefaultFolder(10).Items.FindNext.Move .GetDefaultFolder(3)
Loop
End With
End Sub

Contacts find and delete

Sub Contacts_zoeken_verwijderen()
On Error Resume Next

c00 = "Bedrijf1"

With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(10).Items
.Find("[CompanyName]='" & c00 & "'").Delete
Do Until Err.Number <>0
.FindNext.Delete
Loop
End With
End Sub

Contacts find and adapt

Sub Contacts_zoeken_wijzigen()
On Error Resume Next

c00 = "Bedrijf1"
c01 = "Bedrijf1 BV."

With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(10).Items
With .Find("[CompanyName]='" & c00 & "'")
.CompanyName = c01
.Save
End With

Do Until Err.Number <>0
With .FindNext
.CompanyName = c01
.Save
End With
Loop
End With
End Sub

Distributionlist

Distributionlist properties

Sub distributielijst_eigenschappen()
'CreateItem (olDistlistItem)      CreateItem (7)
'GetDefaultFolder(olFolderContacts)      GetDefaultFolder(10)

c00 = "DL example"

With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(10).Items(c00)
c01 = .Actions.Count
c02 = .Application
c03 = .Attachments.Count
c04 = .body
c05 = .Categories
c06 = .Class
c07 = .Companies
c08 = .ConversationIndex
c09 = .ConversationTopic
c010 = .DLName
c011 = .entryId
c012 = .FormDescription
c013 = .GetInspector
c014 = .Importance
c015 = .LastModificationTime
c016 = .links.Count
c017 = .MemberCount
c018 = .MessageClass
c019 = .Mileage
c020 = .OutlookInternalVersion
c021 = .OutlookVersion
c022 = .Parent
c023 = .Saved
c024 = .Sensitivity
c025 = .Session
c026 = .Size
c027 = .subject
c028 = .UnRead
c029 = .UserProperties
End With
End Sub

New distributionlist

Sub distributielijst_nieuw()
With CreateObject("Outlook.Application").CreateItem(7)
.DLName = "DL voorbeeld"
.Save
End With
End Sub

Distributionlist: read

Sub distributielijst_lezen()
c00 = "DL voorbeeld"         '   DLName

With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(10).Items(c00)
c01 = .DLName & "|" & .MemberCount
End With
End Sub

Contact in distributionlist read

Sub distributielijst_lezen()
c00 = "DL voorbeeld"         '   DLName

With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(10).Items(c00)
If .MemberCount >0 Then
With .GetMember(1)
c01=.Name & "_" & .address & "_" & .AddressEntry
End With
End If
End With
End Sub

Distributionlist: move to another folder

Sub distributielijst_verplaatsen()
c00 = "DL voorbeeld"         '   DLName

With CreateObject("Outlook.Application").GetNamespace("MAPI")
.GetDefaultFolder(10).Items(c00).Move .GetDefaultFolder(3)
End With
End Sub

Distributionlist: delete

Sub distributielijst_verwijderen()
c00 = "DL voorbeeld"         '   DLName

CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(10).Items(c00).Delete
End Sub

Distributionlist: adapt

Sub distributielijst_wijzigen()
c00 = "DL voorbeeld"
c01 = "DL 2e voorbeeld"

With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(10).Items(c00)
.DLName= c01
.Save
End With
End Sub

Distributionlist: add contact

   Alleen bestaande Contacts kunnen aan een distributionlist worden toegevoegd.
Sub distributielijst_wijzigen_kontaktpersoon_toevoegen()
c00 = "DL voorbeeld"
c01 = "K. Franken"

Set c02 = CreateObject("Outlook.Application").CreateItem(0).Recipients
c02.Add c01

With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(10).Items(c00)
.AddMembers c02
.Save
End With
End Sub

Distributionlist: delete contact

Sub distributielijst_wijzigen_kontaktpersoon_verwijderen()
c00 = "DL voorbeeld"
c01 = "K. Franken"

Set c02 = CreateObject("Outlook.Application").CreateItem(0).Recipients
c02.Add c01

With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(10).Items(c00)
.RemoveMembers c02
.Save
End With
End Sub

Distributionlist: delete Contact: alternative method

Sub distributielijst_wijzigen_kontaktpersoon_verwijderen2()
c00 = "DL voorbeeld"
c01 = "anita@planeet.eu"

With CreateObject("outlook.application").GetNamespace("MAPI").GetDefaultFolder(10).Items(c00)
For j = 1 To .MemberCount
If LCase(.GetMember(j).address) = LCase(c01) Then .RemoveMembers .GetMember(j)
Next
.Save
End With
End Sub

Distributionlist: read contacts

Sub distributielijst_kontaktpersoon_lezen()
c00 = "DL voorbeeld"

With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(10).Items(c00)
For j = 1 To .MemberCount
c01 = c01 & "|" & .GetMember(j).Name & "_" & .GetMember(j).Address & "_" & .GetMember(j).AddressEntry
Next
End With
End Sub

Distributionlists: filter and read

Sub distributielijsten_filteren_lezen()
c00 = "DL voorbeeld"

For Each it In CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(10).Items.Restrict("[DLName]='" & c00 & "'")
c01 = c01 & "|" & it.DLName & "_" & it.MemberCount
Next
End Sub

Distributionlists: filter and copy

Sub distributielijsten_filteren_kopiŽren()
c00 = "DL voorbeeld"

For Each it In CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(10).Items.Restrict("[DLName]='" & c00 & "'")
it.Copy
it.Move CreateObject("Outlook.Application").GetNamespace("MAPI").Folders(2).Folders("distributielijst")
Next
End Sub

Distributionlists: filter and move to another folder

Sub distributielijsten_filteren_verplaatsen()
c00 = "DL voorbeeld"

For Each it In CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(10).Items.Restrict("[DLName]='" & c00 & "'")
it.Move CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(3)
Next
End Sub

Distributionlists: filter and delete

Sub distributielijsten_filteren_verwijderen()
c00 = "DL voorbeeld"

For Each it In CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(10).Items.Restrict("[DLName]='" & c00 & "'")
it.Delete
Next
End Sub

Distributionlists: filter and adapt

Sub distributielijsten_filteren_wijzigen()
c00 = "DL voorbeeld"
c01 = "Oude lijst"

For Each it In CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(10).Items.Restrict("[DLName]='" & c00 & "'")
With it
.body = c01
.Save
End With
Next
End Sub

Distributionlists: filter and delete contact

Sub distributielijsten_filteren_wijzigen_kontaktpersoon_verwijderen2()
c01 = "anita@planeet.eu"

For Each it In CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(10).Items.Restrict("[Messageclass]='IPM.DistList'")
Set c02 = CreateObject("Outlook.Application").CreateItem(0).Recipients

For j = 1 To it.MemberCount
If LCase(it.GetMember(j).address) = LCase(c01) Then c02.Add it.GetMember(j)
Next

If c02.Count >0 Then
it.RemoveMembers c02
it.Save
End If
Next
End Sub

Distributionlists: find and read

Sub distributielijsten_zoeken_lezen()
On Error Resume Next

c00 = "DL voorbeeld"

With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(10).Items
c01 = .Find("[DLName]='" & c00 & "'").body
Do Until Err.Number <>0
c01 = c01 & "|" & .FindNext.body
Loop
End With
End Sub

Distributionlists: find and move to another folder

Sub distributielijsten_zoeken_verplaatsen()
On Error Resume Next

c00 = "DL voorbeeld"

With CreateObject("Outlook.Application").GetNamespace("MAPI")
.GetDefaultFolder(10).Items.Find("[DLName]='" & c00 & "'").Move .GetDefaultFolder(3)
Do Until Err.Number <>0
.GetDefaultFolder(10).Items.FindNext.Move .GetDefaultFolder(3)
Loop
End With
End Sub

Distributionlists: find and delete

Sub distributielijsten_zoeken_verwijderen()
On Error Resume Next

c00 = "DL voorbeeld"

With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(10).Items
.Find("[DLName]='" & c00 & "'").Delete
Do Until Err.Number <>0
.FindNext.Delete
Loop
End With
End Sub

Distributionlists: find and adapt

Sub distributielijsten_zoeken_wijzigen()
On Error Resume Next

c00 = "DL voorbeeld"
c01 = "new subject"

With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(10).Items
With .Find("[DLName]='" & c00 & "'")
.subject = c01
.Save
End With

Do Until Err.Number <>0
With .FindNext
.subject = c01
.Save
End With
Loop
End With
End Sub

Notes

Note properties

Sub note_eigenschappen()
'    creatitem(5)
'    createitem(olNoteItem)
'    Getdefaultfolder (12)
'    Getdefaultfolder(olFolderNotes)
'    GetDefaultfolder("notities")

With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(12).Items(1)
c1 = .Application
c2 = .body         'the item's content
c3 = .Categories
c4 = .Class
c5 = .Color
c6 = .CreationTime
c7 = .EntryId
c8 = .GetInspector
c9 = .Height
c10 = .LastModificationTime
c11 = .Left
c12 = .links.Count
c13 = .MessageClass
c14 = .Parent
c15 = .Saved         '   True / False
c16 = .Session
c17 = .Size
c18 = .subject         '   readonly
c19 = .Top
c20 = .Width
End With
End Sub

New note

Sub note_nieuw()
With CreateObject("Outlook.Application").CreateItem(5)
.body = "controle" & vbLf & "kijk eens"
.Save
End With
End Sub

Note: read

Sub note_lezen()
c00 = "controle"

With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(12).Items(c00)
If .Class = 44 Then c01 = .body & "|" & .CreationTime
End With
End Sub

Note: move to another folder

Sub note_verplaatsen()
c00 = "controle"

With CreateObject("Outlook.Application").GetNamespace("MAPI")
.GetDefaultFolder(12).Items(c00).Move .GetDefaultFolder(3)
End With
End Sub

Note: delete

Sub note_verwijderen()
c00 = "controle"

CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(12).Items(c00).Delete
End Sub

Note: adapt

Sub note_wijzigen()
c00 = "controle"

With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(12).Items(c00)
.body = "new subject"
.Top = .Top + 30
.Left = .Left + 40
.Height = 2 * .Height
.Width = 2 * .Width
.Color = 2
.Save
End With
End Sub

Notes: filter and read

Sub notes_filteren_lezen()
c00 = "controle"

With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(12).Items
For Each it In .Restrict("[Subject]='" & c00 & "'")
c01 = c01 & "|" & it.body
Next
End With
End Sub

Notes: filter and move to another folder

Sub notes_filteren_verplaatsen()
c00 = "controle"

With CreateObject("Outlook.Application").GetNamespace("MAPI")
For Each it In .GetDefaultFolder(12).Items.Restrict("[Subject]='" & c00 & "'")
it.Move .GetDefaultFolder(3)
Next
End With
End Sub

Notes: filter and delete

Sub notes_filteren_verwijderen()
c00 = "controle"

For Each it In CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(12).Items.Restrict("[Subject]='" & c00 & "'")
it.Delete
Next
End Sub

Notes: filter and adapt

Sub notes_filteren_wijzigen()
c00 = "controle"
c01 = "new subject"

For Each it In CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(12).Items.Restrict("[Subject]='" & c00 & "'")
With it
.body = c01
.Save
End With
Next
End Sub

Notes: find and read

Sub notes_zoeken_lezen()
On Error Resume Next

c00 = "controle"

With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(12).Items
c01 = .Find("[Subject]='" & c00 & "'").body
Do Until Err.Number <>0
c01 = c01 & "|" & .FindNext.body
Loop
End With
End Sub

Notes: find and move to another folder

Sub notes_zoeken_verplaatsen()
On Error Resume Next

c00 = "controle"

With CreateObject("Outlook.Application").GetNamespace("MAPI")
.GetDefaultFolder(12).Items.Find("[Subject]='" & c00 & "'").Move .GetDefaultFolder(3)
Do Until Err.Number <>0
.GetDefaultFolder(12).Items.FindNext.Move .GetDefaultFolder(3)
Loop
End With
End Sub

Notes: find and delete

Sub notes_zoeken_verwijderen()
On Error Resume Next

c00 = "controle"

With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(12).Items
.Find("[Subject]='" & c00 & "'").Delete
Do Until Err.Number <>0
.FindNext.Delete
Loop
End With
End Sub

Notes: find and adapt

Sub notes_zoeken_wijzigen()
On Error Resume Next

c00 = "controle"
c01 = "new subject"

With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(12).Items
With .Find("[Subject]='" & c00 & "'")
.body = c01
.Save
End With

Do Until Err.Number <>0
With .FindNext
.body = c01
.Save
End With
Loop
End With
End Sub

Appointments

Appointment properties

Sub appointment_eigenschappen()
'   Createitem(1)
'   Createitem(olappointment)
'   Getdefaultfolder(9)
'   Getdefaultfolder(olCalendar)
'   Getdefaultfolder("Agenda")

With CreateObject("outlook.application").GetNamespace("MAPI").GetDefaultFolder(9).Items(1)
c00 = .Actions.Count
For jj = 1 To c0
d0 = .Actions(jj).Name
Next
c01 = .Application
c02 = .Attachments.Count   '   aantal bijlagen
c03 = .BillingInformation
c04 = .body   '   the tiem's content
c05 = .Categories
c06 = .Class
c07 = .Companies
c08 = .ContactNames.Count
c09 = .ConversationIndex
c010 = .ConversationTopic
c011 = .CreationTime
c012 = .Docposted
c013 = .DocPrinted
c014 = .DocRouted
c015 = .DocSaved
c016 = .Duration
c017 = .End
c018 = .entryId
c019 = .FormDescription
c020 = .GetInspector
c021 = .Importance
c022 = .LastModificationTime
c023 = .links.Count
c024 = .Location
c025 = .MeetingStatus
c024 = .MessageClass
c025 = .Mileage
c026 = .NoAging   '   True / False
c027 = .OutlookInternalVersion
c028 = .OutlookVersion
c029 = .Parent
c030 = .Recipients.Count
For jj = 1 To c30
With .Recipients(jj)
d01 = .Name
d02 = .address
d03 = .AddressEntry
End With
Next
c031 = .Saved   '   True / False
c032 = .Sensitivity
c033 = .Session
c034 = .Size
c035 = .start
c036 = .subject
c037 = .Type
c038 = .UnRead   '   True / False
c039 = .UserProperties.Count
End With
End Sub

New appointment

Sub appointment_nieuw()
With CreateObject("Outlook.Application").CreateItem(1)
.subject = "Annual Meeting"
.Start = DateValue("06-03-2019") + TimeValue("12:30")
.Duration = 45
.Location = "Vergaderzaal C"
.Save
End With
End Sub

Appointment: read

Sub appointment_lezen()
c00 = "Annual Meeting"         '   Subject

c01=CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(9).Items(c00).location
End Sub

Appointment: move to another folder

Sub appointment_wijzigen()
c00 = "Annual Meeting"

With CreateObject("Outlook.Application").GetNamespace("MAPI")
.GetDefaultFolder(9).Items(c00).move ..GetDefaultFolder(9)
End With
End Sub

Appointment: delete

Sub appointment_wijzigen()
c00 = "Annual Meeting"

CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(9).Items(c00).delete
End Sub

Appointment: adapt

Sub appointment_wijzigen()
c00 = "Annual Meeting"

With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(9).Items(c00)
.start = DateAdd( "d", 4, .start) + DateAdd( "h", 2, .start)
.Save
End With
End Sub

Appointment: find using several criteria

Sub appointment_zoeken()
On Error Resume Next

c01 = DateValue("06-05-2019") + TimeValue("12:30")      '   .Start
c02 = "onderwerp"                  '   .Subject
c03 = DateAdd("n", 45, c01)      '   .End
c04 = "Vergaderzaal C"                  '   .Location
c05 = "ddddd h:mm"                  '   timeformat

c00 = "[Start] ='" & format(c01, c05) & "'"                  ' zoeken op begintijdstip
c00 = "[Start] ='" & format(c01, c05) & "' And [Subject]='" & c02 & "'"         ' zoeken op begintijdstip en onderwerp
c00 = "[Start] ='" & format(c01, c05) & "' And [Subject]='" & c02 & "' And [Location]='" & c04 & "'"         ' zoeken op begintijdstip, onderwerp en lokatie
c00 = "[Start] ='" & format(c01, c05) & "' And [Subject]='" & c02 & "' And [End]='" & format(c03, c05) & "' And [Location]='" & c04 & "'"   ' zoeken op begintijdstip, onderwerp en lokatie

MsgBox CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(9).Items.Find(c00).start
End Sub

Appointments: filter and read

Sub appointments_filteren_lezen()
c01="Sessie B"
c00 = "[Location]='" & c01 & "'"

For Each it In CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(9).Items.Restrict(c00)
c02 = c02 & "|" & it.Location & it.start
Next
End Sub

Appointments: filter and move to another folder

Sub appointments_filteren_verplaatsen()
c01="Sessie B"
c00 = "[Location]='" & c01 & "'"

with CreateObject("Outlook.Application").GetNamespace("MAPI")
For Each it In .GetDefaultFolder(9).Items.Restrict(c00)
it.move .GetDefaultFolder(3)
Next
End With
End Sub

Appointments: filter and delete

Sub appointments_filteren_verwijderen()
c01="Sessie B"
c00 = "[Location]='" & c01 & "'"

For Each it In CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(9).Items.Restrict(c00)
it.Delete
Next
End Sub

Appointments: filter and adapt

Sub appointments_filteren_wijzigen()
c01="Sessie B"
c02="Room 203"
c00 = "[Location]='" & c01 & "'"

For Each it In CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(9).Items.Restrict(c00)
it.Location = c02
it.start = DateAdd( "d", 1, it.start)
it.Save
Next
End Sub

Appointments: find and read

Sub appointments_zoeken_lezen()
On Error Resume Next

c01 = "11-04-2011 9:00"
c00 = "[Start]>='" & format(c01, "ddddd hh:mm") & "' And [Start]<='" & format(DateAdd( "d", 7, c01), "ddddd hh:mm") & "'"

With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(9).Items
c02 = .Find(c00).subject
Do Until Err.Number >0
c02 = c02 & "|" & .FindNext.subject
Loop
End With
End Sub

Appointments: find and move to another folder

Sub appointments_zoeken_verplaatsen()
On Error Resume Next

c01 = "Sessie B"
c00 = "[Location]='" & c01 & "'"

With CreateObject("Outlook.Application").GetNamespace("MAPI")
.GetDefaultFolder(9).Items.Find(c00).Move .GetDefaultFolder(3)
Do Until Err.Number >0
.GetDefaultFolder(9).Items.FindNext.Move .GetDefaultFolder(3)
Loop
End With
End Sub

Appointments: find and delete

Sub appointments_zoeken_verwijderen()
On Error Resume Next

c01 = "Sessie B"
c00 = "[Location]='" & c01 & "'"

With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(9).Items
.Find(c00).Delete
Do Until Err.Number >0
.FindNext.Delete
Loop
End With
End Sub

Appointments: find and adapt

Sub appointments_zoeken_wijzigen()
On Error Resume Next

c01 = "Sessie B"
c02 = "vergaderzaal A"
c00 = "[Location]='" & c01 & "'"

With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(9).Items
With .Find(c00)
.Location = c02
.Save
End With

Do Until Err.Number <>0
With .FindNext
.Location = c02
.Save
End With
Loop
End With
End Sub

Meeting requests

Meeting request properties

Sub meeting request_eigenschappen()
"'   CreateItem(1)
'   Createitem(olAppointmentitem)
'   Getdefaultfolder(9)
'   Getdefaultfolder(olfolderCalendar)
'   Getdefaultfolder("Agenda")

c00 = "Annual meeting"

With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(6).Items(c00)
c00 = .Actions.Count
For jj = 1 To c0
d0 = .Actions(jj).Name
Next
c01 = .Application
c02 = .Attachments.Count
c03 = .AutoForwarded
c04 = .BillingInformation
c05 = .body   ' inhoud bericht
c06 = .Categories
c07 = .Class   ' 53
c08 = .Companies
c09 = .ConversationIndex
c010 = .ConversationTopic
c011 = .CreationTime
c012 = DeferredDeliveryTime
c013 = DeleteAfterSubmit
c014 = .entryId
c015 = .ExpiryTime
c016 = .FlagDueBy
c017 = .FlagRequest
c018 = .FlagStatus
c019 = .FormDescription
c020 = .GetInspector
c021 = .Importance
C022 = .LastModificationTime
c023 = .links.Count
c024 = .MessageClass
c025 = .Mileage
c026 = .NoAging   ' True / False
c027 = .OriginatorDeliveryReportRequested
c028 = .OutlookInternalVersion
c029 = .OutlookVersion
c030 = .Parent
c031 = .ReceivedTime
c032 = .Recipients.Count
For jj = 1 To c32
With .Recipients(jj)
d01 = .Name
d02 = .address
d03 = .AddressEntry
End With
Next
c033 = .ReminderSet
c034 = .ReminderTime
' c035 = .ReplyRecipients
c036 = .Saved   ' True / False
c037 = .SaveSentMessageFolder
c038 = .SenderName
c039 = .Sensitivity
c040 = .Sent
c041 = .SentOn
c042 = .Session
c043 = .Size
c044 = .subject
c045 = .Submitted
c046 = .UnRead   ' True / False
c047 = .UserProperties.Count
End With
End Sub

New meeting request

Sub meeting request_nieuw()
c00="Annual Meeting"
c01 = "Zaal A"
c02 = format(DateAdd( "d", 2, Date) + TimeValue("20:15"), "ddddd hh:mm")
c03 = 55
c04 = "Jeroen Spoert"

With CreateObject("Outlook.Application").CreateItem(1)
.subject = c00
.MeetingStatus = 1
.Location = c01
.start = c02
.Duration = c03
.Recipients.Add c04
.send
End With
End Sub

Meeting request: read

Sub meeting request_lezen()
' meeting requests nly reside in the folder PostIN: getdefaultfolder(6) getdefaultfolder(olFolderInbox)
c00 = "Annual Meeting"            '   Subject

With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(6).Items(c00)
c01 = .subject & "_" & CreationTime & "_" & .body & "_" & .SenderName & "_" & .Class   ' 53
End With
End Sub

Meeting request: accept tentatively

Sub meeting request_lezen_voorlopig_accepteren()
c00 = "Annual Meeting"

CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(6).Items(c00).GetAssociatedAppointment(True).Respond 2
End Sub

Meeting request: accept

Sub meeting request_lezen_accepteren()
c00 = "Annual Meeting"

CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(6).Items(c00).GetAssociatedAppointment(True).Respond 3
End Sub

Meeting request: decline

Sub meeting request_lezen_weigeren()
c00 = "Annual Meeting"

CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(6).Items(c00).GetAssociatedAppointment(True).Respond 4
End Sub

Meeting request: move to another folder

Sub meeting request_verplaatsen()
c00 = "Annual Meeting"

With CreateObject("Outlook.Application").GetNamespace("MAPI")
.GetDefaultFolder(6).Items(c00).Move .GetDefaultFolder(3)
End With
End Sub

Meeting request: delete

Sub meeting request_verwijderen()
c00 = "Annual Meeting"

CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(6).Items(c00).Delete
End Sub

Meeting requests: filter and read

Sub meeting requests_filteren_lezen()
For Each it In CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(6).Items.Restrict("[MessageClass]='IPM.Schedule.Meeting.Request'")
c01 = c01 & "|" & it.body
Next
End Sub

Meeting requests: filter and accept tentatively

Sub meeting requests_filteren_voorlopig_accepteren()
For Each it In CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(6).Items.Restrict("[Class]='53'")
it.GetAssociatedAppointment(True).Respond 3
Next
End Sub

Meeting requests: filter and accept

Sub meeting requests_filteren_accepteren()
For Each it In CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(6).Items.Restrict("[MessageClass]='IPM.Schedule.Meeting.Request'")
it.GetAssociatedAppointment(True).Respond 2
Next
End Sub

Meeting requests: filter and decline

Sub meeting requests_filteren_weigeren()
For Each it In CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(6).Items.Restrict("[Class]='53'")
it.GetAssociatedAppointment(True).Respond 4
Next
End Sub

Meeting requests: filter and copy

Sub meeting requests_filteren_kopiŽren()
For Each it In CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(6).Items.Restrict("[MessageClass]='IPM.Schedule.Meeting.Request'")
it.Copy
it.Move CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(3)
Next
End Sub

Meeting requests: filter and move to another folder

Sub meeting requests_filteren_verplaatsen()
With CreateObject("Outlook.Application").GetNamespace("MAPI")
For Each it In .GetDefaultFolder(6).Items.Restrict("[Class]='53'")
it.Move .GetDefaultFolder(3)
Next
End With
End Sub

Meeting requests: filter and delete

Sub meeting requests_filteren_verwijderen()
For Each it In CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(6).Items.Restrict("[Class]='53'")
it.Delete
Next
End Sub

Meeting requests: find and read

Sub meeting requests_zoeken_lezen()
On Error Resume Next

c01 = "IPM.Schedule.Meeting.Request"
c02 = "Annual Meeting"
c00 = "[MessageClass]='" & c01 & "' And [Subject]='" & c02 & "'"

With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(6).Items
c01 = .Find(c00).body
Do Until Err.Number <>0
c01 = c01 & "|" & .FindNext.body
Loop
End With
End Sub

Meeting requests: find and accept tentatively

Sub meeting requests_zoeken_voorlopig_accepteren()
On Error Resume Next

c01 = "IPM.Schedule.Meeting.Request"
c02 = "Annual Meeting"
c00 = "[MessageClass]='" & c01 & "' And [Subject]='" & c02 & "'"

With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(6).Items
.Find(c00).GetAssociatedAppointment(True).Respond 3

Do Until Err.Number <>0
.FindNext.GetAssociatedAppointment(True).Respond 3
Loop
End With
End Sub

Meeting requests: find and accept

Sub meeting requests_zoeken_accepteren()
On Error Resume Next

c01 = "IPM.Schedule.Meeting.Request"
c02 = "Annual Meeting"
c00 = "[MessageClass]='" & c01 & "' And [Subject]='" & c02 & "'"

With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(6).Items
.Find(c00).GetAssociatedAppointment(True).Respond 2

Do Until Err.Number <>0
.FindNext.GetAssociatedAppointment(True).Respond 2
Loop
End With
End Sub

Meeting requests: find and decline

Sub meeting requests_zoeken_weigeren()
On Error Resume Next

c01 = "IPM.Schedule.Meeting.Request"
c02 = "Annual Meeting"
c00 = "[MessageClass]='" & c01 & "' And [Subject]='" & c02 & "'"

With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(6).Items
.Find(c00).GetAssociatedAppointment(True).Respond 4

Do Until Err.Number <>0
.FindNext.GetAssociatedAppointment(True).Respond 4
Loop
End With
End Sub

Meeting requests: find and copy

Sub meeting requests_zoeken_kopiŽren()
On Error Resume Next

c01 = "IPM.Schedule.Meeting.Request"
c02 = "Annual Meeting"
c00 = "[MessageClass]='" & c01 & "' And [Subject]='" & c02 & "'"

With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(6).Items
With .Find(c00)
.Copy .Move CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(3)
End With

Do Until Err.Number <>0
With .FindNext
.Copy
.Move CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(3)
End With
Loop
End With
End Sub

Meeting requests: find and move to another folder

Sub meeting requests_zoeken_verplaatsen()
On Error Resume Next

c01 = "IPM.Schedule.Meeting.Request"
c02 = "Annual Meeting"
c00 = "[MessageClass]='" & c01 & "' And [Subject]='" & c02 & "'"

With CreateObject("Outlook.Application").GetNamespace("MAPI")
.GetDefaultFolder(6).Items.Find(c00).Move .GetDefaultFolder(3)

Do Until Err.Number <>0
.GetDefaultFolder(6).Items.FindNext.Move .GetDefaultFolder(3)
Loop
End With
End Sub

Meeting requests: find and delete

Sub meeting requests_zoeken_verwijderen()
On Error Resume Next

c01 = "IPM.Schedule.Meeting.Request"
c02 = "Annual Meeting"
c00 = "[MessageClass]='" & c01 & "' And [Subject]='" & c02 & "'"

With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(6).Items
.Find(c00).Delete

Do Until Err.Number <>0
.FindNext.Delete
Loop
End With
End Sub

Tasks

Task properties

Sub task_eigenschappen()
'   Createitem(3)
'   Createitem(olTaskItem)
'   Getdefaultfolder(13)
'   Getdefaultfolder(olFolderTasks)
'   Getdefaultfolder("Tasks")

With CreateObject("Outlook.application").GetNamespace("MAPI").GetDefaultFolder(13).Items(1)
c00 = .Actions.Count
For jj = 1 To c0
d0 = .Actions(jj).Name
Next
c01 = .ActualWork
c02 = .Application
c03 = .Attachments.Count   ' aantal bijlagen
c04 = .BillingInformation
c05 = .body   ' inhoud bericht
c06 = .CardData
c07 = .Categories
c08 = .Class
c09 = .Companies
c010 = .complete         ' True / False
c011 = .ContactNames.Count
c012 = .Contacts
c0013 = .ConversationIndex
c014 = .ConversationTopic
c015 = .CreationTime
c016 = .DateCompleted
c017 = .DelegationState
c018 = .Delegator
c019 = .DueDate
c020 = .entryId
c021 = .FormDescription
C022 = .GetInspector
c023 = .Importance
c024 = .IsRecurring         ' True / False
c025 = .LastModificationTime
c026 = .links.Count
c027 = .MessageClass
c028 = .Mileage
c029 = .NoAging         ' True / False
c030 = .Ordinal
c031 = .OutlookInternalVersion
c032 = .OutlookVersion
c033 = .Owner
c034 = .Ownership
c035 = .Parent
c036 = .PercentComplete
c037 = .Recipients.Count
c038 = .ReminderOverrideDefault         ' True / False
c039 = .ReminderPlaySound         ' True / False
c040 = .ReminderSet         ' True / False
c041 = .ReminderSoundFile
c042 = .ReminderTime
c043 = .ResponseState
c044 = .Role
c045 = .Saved         ' True / False
c046 = .SchedulePlusPriority
c047 = .Sensitivity
c048 = .Session
c049 = .Size
c050 = .StartDate
c051 = .Status
c052 = .StatusOnCompletionRecipients
c053 = .StatusUpdateRecipients
c054 = .subject
c055 = .TeamTask         ' True / False
c056 = .TotalWork
c057 = .UnRead         ' True / False
c058 = .UserProperties.Count
End With
End Sub

New task

Sub task_nieuw()
With CreateObject("Outlook.Application").CreateItem(3)
c00 = "controle"
c01 = Date
c02 = DateValue("04-05-2019") + TimeValue("08:00:00")

.subject = c00
.StartDate = c01
.ReminderSet = True
.ReminderTime =c02
.Save
End With
End Sub

Task: read

Sub task_lezen()
c00 = "controle"         '   Subject

With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(13).Items(c00)
c01=.startdate & "_" & .Subject & "_" & .Status
End With
End Sub

Task: move to another folder

Sub task_verplaatsen()
c00 = "controle"

With CreateObject("Outlook.Application").GetNamespace("MAPI")
.GetDefaultFolder(13).Items(c00).move .Getdefaultfolder(3)
End With
End Sub

Task: delete

Sub task_verwijderen()
c00 = "controle"

CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(13).Items(c00).delete
End Sub

Task: find using several criteria

Sub task_zoeken_meer_criteria()
c02 = DateValue("15-04-2011")
c01 = "New controle"
c00 = "[StartDate] ='" & format(c02, "ddddd") & "' And [Subject]='" & c01 & "'"

With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(13).Items
If Not .Find(c00) Is Nothing Then c03 = .Find(c00).ReminderTime
End With
End Sub

Task: adapt

Sub task_wijzigen()
c00 = "controle"
c01 = "New controle"

With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(13).Items(c00)
.subject = c01
.Save
End With
End Sub

Tasks: filter and read

Sub tasks_filteren_lezen()
c01 = DateValue("11-04-2011")
c00 = "[StartDate] ='" & format(c00, "ddddd") & "'"

For Each it In CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(13).Items.Restrict(c00)
c02 = c02 & "|" & it.subject
Next
End Sub

Tasks: filter and move to another folder

Sub tasks_filteren_verplaatsen()
c01 = DateValue("11-04-2019")
c00 = "[StartDate] ='" & format(c00, "ddddd") & "'"

With CreateObject("Outlook.Application").GetNamespace("MAPI")
For Each it In .GetDefaultFolder(13).Items.Restrict(c00)
it.move .GetDefaultFolder(3)
Next
end with
End Sub

Tasks: filter and delete

Sub tasks_filteren_verwijderen()
c01 = DateValue("11-04-2011")
c00 = "[StartDate] ='" & format(c00, "ddddd") & "'"

For Each it In CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(13).Items.Restrict(c00)
it.Delete
Next
End Sub

Tasks: filter and adapt

Sub tasks_filteren_wijzigen()
c01 = DateValue("11-04-2011")
c00 = "[StartDate] ='" & format(c00, "ddddd") & "'"

For Each it In CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(13).Items.Restrict(c00)
it.StartDate = DateAdd( "d", -4, it.StartDate)
it.Save
Next
End Sub

Tasks: find and read

Sub tasks_zoeken_lezen()
On Error Resume Next

c01 = DateValue("11-04-2011")
c00 = "[StartDate] ='" & format(c00, "ddddd") & "'"

With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(13).Items
c02 = .Find(c00).Subject

Do Until err.number<>0
c02 = c02 & "|" & .FindNext.Subject
Loop
End With
End Sub

Tasks: find and move to another folder

Sub tasks_zoeken_verplaatsen()
On Error Resume Next

c01 = "New controle"
c00 = "[Subject] ='" & c01 & "'"

With CreateObject("Outlook.Application").GetNamespace("MAPI")
.GetDefaultFolder(13).Items.Find(c00).move .GetDefaultFolder(3)

Do Until err.number<>0
.GetDefaultFolder(13).Items.FindNext.move .GetDefaultFolder(3)
Loop
End With
End Sub

Tasks: find and delete

Sub tasks_zoeken_verwijderen()
On Error Resume Next

c01 = "New controle"
c00 = "[Subject] ='" & c01 & "'"

With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(13).Items
.Find(c00).delete

Do Until err.number<>0
.FindNext.delete
Loop
End With
End Sub

Tasks: find and adapt

Sub tasks_zoeken_wijzigen()
On Error Resume Next

c01 = "New controle"
c00 = "[Subject] ='" & c01 & "'"

With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(13).Items
With .Find(c00)
.StartDate = DateAdd( "d", 4, .StartDate)
.Save
End With

Do Until err.number<>0
with .FindNext
.StartDate = DateAdd( "d", 4, .StartDate)
.Save
End With
Loop
End With
End Sub

Taskrequests

Taskrequest properties

Sub taskrequest_eigenschappen()
'   CreateItem(3)
'   CreateItem(olTask)
'   GetDefaultFolder(13)
'   GetDefaultFolder(olFolderTasks)
'   GetDefaultFolder("Tasks")

With CreateObject("outlook.application").GetNamespace("MAPI").GetDefaultFolder(13).Items(1)
c00 = .Actions.Count
For jj = 1 To c0
d0 = .Actions(jj).Name
Next
c01 = .Application
c02 = .Attachments.Count   ' number of attachments
c03 = .BillingInformation
c04 = .body   ' the item's content
c05 = .Categories
c06 = .Class         '   49
c07 = .Companies
c08 = .ConversationIndex
c09 = .ConversationTopic
c010 = .CreationTime
c011 = .entryId
c012 = .FormDescription
c013 = .GetInspector
c014 = .Importance
c015 = .LastModificationTime
c016 = .links.Count
c017 = .MessageClass
c018 = .Mileage
c019 = .NoAging   ' True / False
c020 = .OutlookInternalVersion
c021 = .OutlookVersion
C022 = .Parent
c023 = .Saved   ' True / False
c024 = .Sensitivity
c025 = .Session
c026 = .Size
c027 = .subject
c028 = .UnRead   ' True / False
c029 = .UserProperties.Count
End With
End Sub

New taskrequest

Sub taskrequest_nieuw()
c00 = "controle 7"
c01 = Date +7"
c02 = DateValue(""04-05-2019") + TimeValue("08:00:00"
c03 = "snb@forums.eu"

With CreateObject("Outlook.Application").CreateItem(3)
.assign
.subject = c00
.StartDate = c01
.ReminderSet = True
.ReminderTime = c02
.Recipients.Add c03
.send
End With
End Sub

Taskrequest: read

Sub taskrequest_lezen()
c00 = "Taskrequest: controle 7"

With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(6).Items(c00)
c01 = .subject & "_" & .CreationTime & "_" & .body & "_" & .Class & "_" & .MessageClass
End With
End Sub

Taskrequest: accept tentatively

Sub taskrequest_lezen_simple_accepteren()
c00 = "Taskrequest: controle 7"

CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(6).Items(c00).GetAssociatedTask(True).Respond 0, False, False
End Sub

Taskrequest: accept

Sub taskrequest_lezen_accepteren()
c00 = "Taskrequest: controle 7"

CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(6).Items(c00).GetAssociatedTask(True).Respond 2, True, True
End Sub

Taskrequest: decline

Sub taskrequest_lezen_weigeren()
c00 = "Taskrequest: controle 7"

CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(6).Items(c00).GetAssociatedTask(True).Respond 3, False, False
End Sub

Taskrequest: move to another folder

Sub taskrequest_verplaatsen()
c00 = "Taskrequest: controle 7"

With CreateObject("Outlook.Application").GetNamespace("MAPI")
.GetDefaultFolder(6).Items(c00).Move .GetDefaultFolder(3)
End With
End Sub

Taskrequest: delete

Sub taskrequest_verwijderen()
c00 = "Taskrequest: controle 7"

CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(6).Items(c00).Delete
End Sub

Taskrequests: filter and read

Sub taskrequests_filteren_lezen()
For Each it In CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(6).Items.Restrict("[MessageClass]='IPM.TaskRequest'")
c01 = c01 & "|" & it.body
Next
End Sub

Taskrequests: filter and accept tentatively

Sub taskrequests_filteren_voorlopig_accepteren()
c01 = "IPM.TaskRequest"
c00 = "[MessageClass]='" & c01 &'"

For Each it In CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(6).Items.Restrict(c00)
it.GetAssociatedTask(True).Respond 0, False, False
Next
End Sub

Taskrequests: filter and accept

Sub taskrequests_filteren_accepteren()
c01 = "IPM.TaskRequest"
c00 = "[MessageClass]='" & c01 &'"

For Each it In CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(6).Items.Restrict(c00)
it.GetAssociatedTask(True).Respond 2, False, False
Next
End Sub

Taskrequests: filter and decline

Sub taskrequests_filteren_weigeren()
c01 = "IPM.TaskRequest"
c00 = "[MessageClass]='" & c01 &'"

For Each it In CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(6).Items.Restrict(c00)
it.GetAssociatedTask(True).Respond 3, False, False
Next
End Sub

Taskrequests: filter and copy

Sub taskrequests_filteren_kopiŽren()
c01 = "IPM.TaskRequest"
c00 = "[MessageClass]='" & c01 &'"

With CreateObject("Outlook.Application").GetNamespace("MAPI")
For Each it In .GetDefaultFolder(6).Items.Restrict(c00)
it.Copy
it.Move .GetDefaultFolder(3)
Next
end with
End Sub

Taskrequests: filter and move to another folder

Sub taskrequests_filteren_verplaatsen()
c01 = "IPM.TaskRequest"
c00 = "[MessageClass]='" & c01 &'"

With CreateObject("Outlook.Application").GetNamespace("MAPI")
For Each it In .GetDefaultFolder(6).Items.Restrict(c00)
it.Move .GetDefaultFolder(3)
Next
End With
End Sub

Taskrequests: filter and delete

Sub taskrequests_filteren_verwijderen()
c01 = "IPM.TaskRequest"
c00 = "[MessageClass]='" & c01 &'"

For Each it In CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(6).Items.Restrict(c00)
it.Delete
Next
End Sub

Taskrequests: filter and adapt

Sub taskrequests_filteren_wijzigen()
c01 = "IPM.TaskRequest"
c02 = "new subject"

c00 = "[MessageClass]='" & c01 &'"

For Each it In CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(6).Items.Restrict(c00)
With it
.body = c02
.Save
End With
Next
End Sub

Taskrequests: find and read

Sub taskrequests_zoeken_lezen()
On Error Resume Next

c01 = "IPM.TaskRequest"
c00 = "[MessageClass]='" & c01 &'"

With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(6).Items
c02 = .Find(c00).body

Do Until Err.Number <>0
c02 = c02 & "|" & .FindNext.body
Loop
End With
End Sub

Taskrequests: find and move to another folder

Sub taskrequests_zoeken_verplaatsen()
On Error Resume Next

c01 = "IPM.TaskRequest"
c00 = "[MessageClass]='" & c01 &'"

With CreateObject("Outlook.Application").GetNamespace("MAPI")
.GetDefaultFolder(6).Items.Find(c00).Move .GetDefaultFolder(3)

Do Until Err.Number <>0
.GetDefaultFolder(6).Items.FindNext.Move .GetDefaultFolder(3)
Loop
End With
End Sub

Taskrequests: find and delete

Sub taskrequests_zoeken_verwijderen()
On Error Resume Next

c01 = "opdracht"
c00 = "[ConversationTopic]='" & c01 &'"

With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(6).Items
.Find(c00).Delete

Do Until Err.Number <>0
.FindNext.Delete
Loop
End With
End Sub

Taskrequests: find and adapt

Sub taskrequests_zoeken_wijzigen()
On Error Resume Next

c01 = "IPM.TaskRequest"
c00 = "[MessageClass]='" & c01 &'"

c02 = "New Subject"

With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(6).Items
With .Find(c00)
.body = c02
.Save
End With

Do Until Err.Number <>0
With .FindNext
.body = c02
.Save
End With
Loop
End With
End Sub

Journalitems

Journalitem properties

Sub journalitem_eigenschappen()
'   CreateItem(4)
'   CreateItem(olJournaItem)
'   GetDefaultFolder(11)
'   GetDefaultFolder(olFolderJournal)
'   GetDefaultFolder("Journal")

With CreateObject("outlook.application").GetNamespace("MAPI").GetDefaultFolder(11).Items(1)
c00 = .Actions.Count
For jj = 1 To c00
d0 = .Actions(jj).Name
Next
c01 = .Application
c02 = .Attachments.Count   ' aantal bijlagen
c03 = .BillingInformation
c04 = .body   ' inhoud bericht
c05 = .Categories
c06 = .Class
c07 = .Companies
c08 = .ContactNames.Count
c09 = .ConversationIndex
c010 = .ConversationTopic
c011 = .CreationTime
c012 = .Docposted   ' True / False
c013 = .DocPrinted   ' True / False
c014 = .DocRouted   ' True / False
c015 = .DocSaved   ' True / False
c016 = .Duration
c017 = .End
c018 = .entryId
c019 = .FormDescription
c020 = .GetInspector
c021 = .Importance
C022 = .LastModificationTime
c023 = .links.Count
c024 = .MessageClass
c025 = .Mileage
c026 = .NoAging   ' True / False
c027 = .OutlookInternalVersion
c028 = .OutlookVersion
c029 = .Parent
c030 = .Recipients.Count
For Each rp In .Recipients
d01 = rp.Name
d02 = rp.address
d03 = rp.AddressEntry
Next
c031 = .Saved   ' True / False
c032 = .Sensitivity
c033 = .Session
c034 = .Size
c035 = .start
c036 = .subject
c037 = .Type
.Type = "Letter"
.Type = "Conversation"
.Type = "Document"
.Type = "E-mail Message"
.Type = "Remote Session"
.Type = "Fax"
.Type = "Microsoft Access"
.Type = "Microsoft Excel"
.Type = "Microsoft Word"
.Type = "Microsoft Powerpoint"
.Type = "Note"
.Type = "Phone Call"
.Type = "Task"
.Type = "Task Request"
.Type = "Meeting"
.Type = "Meeting Request"
.Type = "Meeting Response"
.Type = "Meeting Cancellation"
c038 = .UnRead   ' True / False
c039 = .UserProperties.Count
End With
End Sub

New journalitem

Sub journalitem_nieuw()
c00 = Now
c01 = 15
c02 = 4th journalitem
c03 = "E-mail Message"

With CreateObject("Outlook.Application").CreateItem(4)
.start = format(c00, "ddddd hh:mm")
.Duration = c01
.subject = c02
.Type = c03
.Save
End With
End Sub

Journalitem: read

Sub journalitem_lezen()
c00 = "4th journalitem"

c01 = CreateObject("outlook.application").GetNamespace("MAPI").GetDefaultFolder(11).Items(c00).Type
End Sub

Journalitem: move to another folder

Sub journalitem_verplaatsen()
c00 = "4e journalitem"

With CreateObject("Outlook.Application").GetNamespace("MAPI")
.GetDefaultFolder(11) .Items(c00).move .GetDefaultFolder(3)
End With
End Sub

Journalitem: delete

Sub journalitem_verwijderen()
c00 = "4e journalitem"

CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(11).Items(c00).Delete
End Sub

Journalitem: adapt

Sub journalitem_wijzigen()
c00 = "4e journalitem"
c02 = "Meeting"

With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(11).Items(c00)
.Type = c02
.Save
End With
End Sub

Journalitem: find

Sub journalitem_zoeken()
On Error Resume Next

c01 = "Meeting"
c00 = [Type] ='" & c01 & "'")

c02 = CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(11).Items.Find(c00).subject
End Sub

Journalitems: filter and read

Sub journalitems_filteren_lezen()
c01 = "Meeting"
c00 = "[Type]='" & c01 & "'"

For Each it In CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(11).Items.Restrict(c00)
c02 = c02 & "|" & it.subject
Next
End Sub

Journalitems: filter and move to another folder

Sub journalitems_filteren_verplaatsen()
c01 = "Meeting"
c00 = "[Type]='" & c01 & "'"

With CreateObject("Outlook.Application").GetNamespace("MAPI")
For Each it In .GetDefaultFolder(11).Items.Restrict(c00)
it.move .GetDefaultFolder(3)
Next
End With
End Sub

Journalitems: filter and delete

Sub journalitems_filteren_verwijderen()
c01 = "Meeting"
c00 = "[Type]='" & c01 & "'"

For Each it In CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(11).Items.Restrict(c00)
it.Delete
Next
End Sub

Journalitems: filter and adapt

Sub journalitems_filteren_wijzigen()
c01 = "Meeting"
c02 = "New tekst"
c00 = "[Type]='" & c01 & "'"

For Each it In CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(11).Items.Restrict(c00)
it.subject = c02
it.Save
Next
End Sub

Journalitems: find and read

Sub journalitems_zoeken_lezen()
On Error Resume Next

c01 = "Meeting"
c00 = "[Type]='" & c01 & "'"

With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(11).Items
c02 = .Find(c00).Subject

Do Until Err.Number<>0
c02 = c02 & "|" & .FindNext.Subject
Loop
End With
End Sub

Journalitems: find and move to another folder

Sub journalitems_zoeken_verplaatsen()
On Error Resume Next

c01 = "Meeting"
c00 = "[Type]='" & c01 & "'"

With CreateObject("Outlook.Application").GetNamespace("MAPI")
.GetDefaultFolder(11).Items.Find(c00).Move .GetDefaultFolder(3)

Do Until Err.Number<>0
.GetDefaultFolder(11).Items.Find(c00).Move .GetDefaultFolder(3)
Loop
End With
End Sub

Journalitems: find and delete

Sub journalitems_zoeken_verwijderen()
On Error Resume Next

c01 = "Meeting"
c00 = "[Type]='" & c01 & "'"

With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(11).Items
.Find(c00).Delete
Do Until Err.Number <>0
.FindNext.Delete
Loop
End With
End Sub

Journalitems: find and adapt

Sub journalitems_zoeken_wijzigen()
On Error Resume Next

c01 = "Meeting"
c02 = "new subject"
c00 = "[Type]='" & c01 & "'"

With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(11).Items
With .Find(c00)
.Subject = c02
.Save
End With

Do Until err.number<>0
with .FindNext
.Subject =c02
.Save
End With
Loop
End With
End Sub

Post items

Postitem properties

Sub discussie_eigenschappen()
'   CreateItem(6)
'   CreateItem(olPost)

With CreateObject("outlook.application").GetNamespace("MAPI").GetDefaultFolder(6).Items(1)
c00 = .Actions.Count
For Each ac In .Actions
d0 = ac.Name
Next
c01 = .Application
c02 = .Attachments.Count      ' aantal bijlagen
c03 = .BillingInformation
c04 = .body      ' the item's content
c05 = .Categories
c06 = .Class
c07 = .Companies
c08 = .ConversationIndex
c09 = .ConversationTopic
c010 = .CreationTime
c011 = .entryId
c012 = .ExpiryTime
c013 = .FormDescription
c014 = .GetInspector
c015 = .HTMLBody
c016 = .Importance
c017 = .LastModificationTime
c018 = .links.Count
c019 = .MessageClass
c020 = .Mileage
c021 = .NoAging            ' True / False
C022 = .OutlookInternalVersion
c023 = .OutlookVersion
c024 = .Parent
c025 = .ReceivedTime
c026 = .Saved         ' True / False
c027 = .SenderName
c028 = .Sensitivity
c029 = .SentOn
c030 = .Session
c031 = .Size
c032 = .subject
c033 = .UnRead         ' True / False
c034 = .UserProperties.Count
End With
End Sub

New Post

Sub discussie_nieuw()
c00 = "New postbodes"

With CreateObject("Outlook.application").CreateItem(6)
.Subject = c00
.Save
End With
End Sub

New Post in specific folder

Sub discussie_nieuw_in_specifieke_map()
c00 = "New postbodes"

With CreateObject("Outlook.application").CreateItem(6)
.Subject = c00
.Save
.Move .Application.GetNamespace("MAPI").GetDefaultFolder(16)
End With
End Sub

Post: read

Sub discussie_lezen()
c00 = "New postbodes"

c01 = CreateObject("Outlook.application").GetNamespace("MAPI").GetDefaultFolder(6).Items(c00).Class
End Sub

Post: move to another folder

Sub discussie_verplaatsen()
c00 = "New postbodes"

With CreateObject("Outlook.Application").GetNamespace("MAPI")
.GetDefaultFolder(6).Items(c00).Move .GetDefaultFolder(16)
End With
End Sub

Post: delete

Sub discussie_verwijderen()
c00 = "New postbodes"

CreateObject("Outlook.application").GetNamespace("MAPI").GetDefaultFolder(16).Items(c00).Delete
End Sub

Post: adapt

Sub discussie_wijzigen()
c00 = "New postbodes"
c01 = "oud verhaal"

With CreateObject("Outlook.application").GetNamespace("MAPI").GetDefaultFolder(6).Items(c00)
.Subject = c01
.Save
End With
End Sub

Post: find

Sub discussie_zoeken()
c01 = "New postbodes"
c00 ="[Subject]='" & c01 & "'"

c01 = CreateObject("Outlook.application").GetNamespace("MAPI").GetDefaultFolder(6).Items.Find(c00).SentOn
End Sub

Posts: filter and read

Sub discussies_filteren_lezen()
c01 = "New postbodes"
c00 ="[Subject]='" & c01 & "'"

For Each it In CreateObject("Outlook.application").GetNamespace("MAPI").GetDefaultFolder(16).Items.Restrict(c00)
c01 = c01 & "|" & it.SentOn
Next
End Sub

Posts: filter and move to another folder

Sub discussies_filteren_verplaatsen()
c00 = "New postbodes"
c00 ="[Subject]='" & c01 & "'"

With CreateObject("Outlook.application").GetNamespace("MAPI")
For Each it In .GetDefaultFolder(6).Items.Restrict(c00)
it.Move .GetDefaultFolder(3)
Next
End With
End Sub

Posts: filter and delete

Sub discussies_filteren_verwijderen()
c00 = "New postbodes"
c00 ="[Subject]='" & c01 & "'"

For Each it In CreateObject("Outlook.application").GetNamespace("MAPI").GetDefaultFolder(6).Items.Restrict(c00)
it.Delete
Next
End Sub

Posts: filter and adapt

Sub discussies_filteren_wijzigen()
c00 = "New postbodes"
c02 = "New onderwerpen"
c00 ="[Subject]='" & c01 & "'"

For Each it In CreateObject("Outlook.application").GetNamespace("MAPI").GetDefaultFolder(16).Items.Restrict(c00)
it.Subject = c02
it.Save
Next
End Sub

Posts: find and read

Sub discussies_zoeken_lezen()
On Error Resume Next

c01 = "New postbodes"
c00 ="[Subject]='" & c01 & "'"

With CreateObject("Outlook.application").GetNamespace("MAPI").GetDefaultFolder(16).Items
c02 = .Find(c00).Body

Do Until Err.Number <>0
c02 = c02 & "|" & .FindNext.Body
Loop
End With
End Sub

Posts: find and move to another folder

Sub discussies_zoeken_verplaatsen()
On Error Resume Next

c01 = "New postbodes"
c00 ="[Subject]='" & c01 & "'"

With CreateObject("Outlook.application").GetNamespace("MAPI")
.GetDefaultFolder(16).Items.Find(c00).Move .GetDefaultFolder(6)

Do Until Err.Number <>0
.GetDefaultFolder(16).Items.FindNext.Move .GetDefaultFolder(6)
Loop
End With
End Sub

Posts: find and delete

Sub discussies_zoeken_verwijderen()
On Error Resume Next

c01 = "New postbodes"
c00 ="[Subject]='" & c01 & "'"

With CreateObject("Outlook.application").GetNamespace("MAPI").GetDefaultFolder(16).Items
.Find(c00).Delete

Do Until Err.Number <>0
.FindNext.Delete
Loop
End With
End Sub

Posts: find and adapt

Sub discussies_zoeken_wijzigen()
On Error Resume Next

c01 = "New postbodes"
c02 = "New onderwerpen"
c00 ="[Subject]='" & c01 & "'"

With CreateObject("Outlook.application").GetNamespace("MAPI").GetDefaultFolder(16).Items
With .Find(c00)
.Subject = c02
.Save
End With

Do Until Err.Number <>0
With .FindNext
.Subject = c02
.Save
End With
Loop
End With
End Sub