1

I want to loop through a list of email addresses and check if they have OOF's turned on (these will be other people's email addresses). Then if possible retrieve the OOF text.

I tried the options of getting the OOF through VBA but with my own trial and error and googling I can see that most people (and myself) realize it's only possible to get your own OOF information.

Sub Check_OOF()

    Dim oNS As Outlook.NameSpace
    Dim oStores As Outlook.Stores
    Dim oStr As Outlook.Store
    Dim oPrp As Outlook.PropertyAccessor

    Set oNS = Outlook.GetNamespace("MAPI")
    Set oStores = oNS.Stores

    For Each oStr In oStores
        If oStr.ExchangeStoreType = olPrimaryExchangeMailbox Then
            Set oPrp = oStr.PropertyAccessor
            MsgBox oPrp.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x661D000B")
        End If
    Next

End Sub

Is this possible with Outlook-Redemption? I can only see the syntax to interact with your own automatic reply.

Community
  • 1
  • 1
  • 1
    Have you looked up any code or tried anything? – pgSystemTester Oct 10 '19 at 21:48
  • A couple of tips for using the site: 1) To be sure someone is notified of a response in comments, prefix the screen name with `@` (@CindyMeister, for example). 2) It's a good idea to include additional, relevant informtion *in the question*, rather than a comment (alone). You can use the [edit] link below a question to change/expand it. – Cindy Meister Oct 10 '19 at 22:09

2 Answers2

1

You will need to use EWS - GetMailTips operation.

Also you can use Redemption, see RDOMailTips object for more information.

Eugene Astafiev
  • 47,483
  • 3
  • 24
  • 45
1

Thanks for pointing me in the right direction Eugene, also Dmitry thanks again for redemption.

I installed redemption by downloading here and installing it via the command line (thanks for the clear instructions). I'm using the RDOMailTips object which allowed me to loop through mailbox's and retrieve OOF messages and other helpful information.

Below is an example I quickly wrote to show the basic premise of looping through emails and getting OOF's text and start/end date.

Sub Get_OOF()

Dim session As Redemption.RDOSession
Dim arr As Variant

Set session = CreateObject("Redemption.RDOSession")
session.Logon
session.SkipAutodiscoverLookupInAD = True

 arr = Array("user1@email.com", "user2@email.com", "user3@email.com")

 For i = LBound(arr) To UBound(arr)
    Set AdrEntry = session.AddressBook.ResolveName(arr(i))
    Set mailtips = AdrEntry.GetMailTips
    Debug.Print mailtips.OutOfOfficeMessage
    Debug.Print mailtips.OutOfOfficeEndTime
    Debug.Print mailtips.OutOfOfficeStartTime
Next i

Set session = Nothing
Set AdrEntry = Nothing
Set mailtips = Nothing

End Sub

Four things to note

  1. If the person doesn't have an out of office it will return an empty string
  2. If the person hasn't set out of office dates it will return 01/01/4501 which I assume is an error code formatted as a date
  3. You will need to split the string from mailtips.OutOfOfficeMessage as it has a lot of formatting fluff around the out of office text
  4. I didn't need to put my credentials in the parameters of AdrEntry.GetMailTips for this to work. But as the documentation says this is optional for EWS.