im using Outlook 2013 and need help activating Out Of Office with VBA. I have trouble setting a starting and endtime as well as formatting my message. I seem not to be able to use html tags...
Is there also a way of getting my current signature?
The code so far:
Sub absence(toggle As Boolean)
Const PR_OOF_STATE = "http://schemas.microsoft.com/mapi/proptag/0x661D000B"
Dim oStore As Outlook.Store, oProp As Outlook.PropertyAccessor
Dim oStorageItem As Outlook.StorageItem
Set oStorageItem = Application.Session.GetDefaultFolder(olFolderInbox).GetStorage("IPM.Note.Rules.OofTemplate.Microsoft", olIdentifyByMessageClass)
oStorageItem.Body = "<html><body><b>I am curerntly not available...</b></body></html>"
oStorageItem.Save
For Each oStore In Session.Stores
If oStore.ExchangeStoreType = olPrimaryExchangeMailbox Then
Set oProp = oStore.PropertyAccessor
oProp.SetProperty PR_OOF_STATE, toggle 'If true: start OOF, if false: quit OOF
End If
Next
Set olkIS = Nothing
Set olkPA = Nothing
End Sub
Anyone got an idea? Any help appreciated.
HTML OOF replies and time ranges can only be set using EWS - see SetUserOofSettings operation on MSDN (https://learn.microsoft.com/en-us/exchange/client-developer/web-service-reference/setuseroofsettings-operation)
Related
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.
You will need to use EWS - GetMailTips operation.
Also you can use Redemption, see RDOMailTips object for more information.
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
If the person doesn't have an out of office it will return an empty string
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
You will need to split the string from mailtips.OutOfOfficeMessage as it has a lot of formatting fluff around the out of office text
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.
How do I turn on the out of office reply with VBA in Office 2010?
I can only find answers for previous Office versions.
Ideally I want the code to disable when I open Outlook 2010 and enable when I close it.
Private Sub Test()
Const PR_OOF_STATE = "http://schemas.microsoft.com/mapi/proptag/0x661D000B"
Dim olkIS As Outlook.Store
Dim olkPA As Outlook.PropertyAccessor
For Each olkIS In Session.Stores
If olkIS.ExchangeStoreType = olPrimaryExchangeMailbox Then
Set olkPA = olkIS.PropertyAccessor
olkPA.SetProperty PR_OOF_STATE, True
End If
Next
Set olkIS = Nothing
Set olkPA = Nothing
End Sub
You can use Store.PropertyAccessor.SetProperty to set the PR_OOF_STATE MAPI property (DASL name http://schemas.microsoft.com/mapi/proptag/0x661D000B) property to true to turn OOF on and false to turn it off.
If you want to explicitly set the OOF time range, you can only do that using EWS (SetUserOofSettings operation). You would need to know the user credentials of course.
I need to select the entire text in the email I'm typing, and change the spelling language.
The following works in Word but doesn't in Outlook 2013.
I added Microsoft Word 15 Object library, with tools -> references, from the VBA editor window.
Selection.WholeStory
Selection.LanguageID = wdEnglishUK
Selection.NoProofing = False
Application.CheckLanguage = False
Methods and properties specific to one application's VBA language can't be used in other applications like that.
There is a lot of information out there, try a search for "Outlook VBA Change Message Body Language" and variations of that.
Some resources to get you started:
Stack Overflow: Outlook VBA Set language of selection
MSDN: Working with Item Bodies with Outlook/VBA
MSDN: MailItem Object (Outlook)
Stack Overflow: Display email body of selected email in Outlook as a message box in Excel
MSDN: Introduction to Outlook VBA
NoProofing should work as intended.
Option Explicit
Private Sub Proofing_EnglishUK()
Dim oMailItm As Object
Dim oInsp As Object
Dim oMailEd As Object
Dim oWord As Object
Dim Rng As Object
Set oInsp = ActiveInspector
If oInsp.currentItem.Class = olMail Then
Set oMailItm = oInsp.currentItem
If oInsp.EditorType = olEditorWord Then
Set oMailEd = oMailItm.GetInspector.WordEditor
Set oWord = oMailEd.Application
Set Rng = oWord.Selection
Rng.WholeStory
With Rng
.LanguageID = wdEnglishUK
' This should work as intended
'.NoProofing = False
' ******* temporary *************
' Check whether .NoProofing can be set
' with a spelling error somewhere in the mail
.NoProofing = Not .NoProofing
If .NoProofing = False Then
MsgBox "Proofing on. Errors should be found."
Else
MsgBox "Proofing off. The errors will not be found."
End If
' ******* temporary *************
End With
oMailItm.Save
End If
End If
Set Rng = Nothing
Set oWord = Nothing
Set oMailEd = Nothing
Set oMailItm = Nothing
End Sub
Please advise me on parts of this or the whole thing if possible. I basically have an email every morning with 5-8 links to reports (on Sharepoint) and have to click each one, which then opens an excel document with the report, click refresh all, save then go back to outlook and click the next link. Is there a way to open the first link in Outlook, go to excel refresh all, save, then go back to Outlook and open the next link and repeat until all links have been pressed in VBA? Any and all help is greatly appreciated, Thank you.
Function GetCurrentItem() As Object
Dim objApp As Outlook.Application
Set objApp = Application
On Error Resume Next
Select Case TypeName(objApp.ActiveWindow)
Case "Explorer"
Set GetCurrentItem = objApp.ActiveExplorer.Selection.Item(1)
Case "Inspector"
Set GetCurrentItem = objApp.ActiveInspector.CurrentItem
End Select
Set objApp = Nothing
End Function
Sub Hyperlink(itm As MailItem)
Dim bodyString As String
Dim bodyStringSplitLine
Dim bodyStringSplitWord
Dim splitLine
Dim splitWord
bodyString = itm.Body
bodyStringSplitLine = Split(bodyString, vbCrLf)
For Each splitLine In bodyStringSplitLine
bodyStringSplitWord = Split(splitLine, " ")
For Each splitWord In bodyStringSplitWord
splitWord.Hyperlink.Select
Next
Next
Set itm = Nothing
End Sub
Sub test()
Dim currItem As MailItem
Set currItem = GetCurrentItem
Hyperlink currItem
End Sub
This is what I have come up with so far. Definitely contains errors. I just run the sub test() in the end.
There is a .Follow in Word.
Sub Hyperlink(itm As mailitem)
Dim oDoc As Object
Dim h As Hyperlink
If itm.GetInspector.EditorType = olEditorWord Then
Set oDoc = itm.GetInspector.WordEditor
For Each h In oDoc.Hyperlinks
Debug.Print h.Name
If Right(h.Name, 5) = ".xlsx" Then
h.Follow
End If
Next
End If
Set oDoc = Nothing
End Sub
You can handle the NewMailEx event of the Application class to handle all incoming emails. Then in the event handler you can parse the HTMLBody property value and extract links. Then you can do whatever you need with links - open them in the browser and etc.
I'd recommend starting from the Getting Started with VBA in Outlook 2010 article in MSDN. Then you may find a lot of HOWTO articles in the Concepts (Outlook 2013 developer reference) section.
Your problem is a bit too large, and although not too difficult, it involves multiple object library references (Regular Expressions, Internet Explorer, Excel). It is unlikely you that you will get a full solution to your problem. VBA is a really powerful and cool scripting language and not too difficult to learn. I highly recommend you divide your problem into smaller tasks, and try to work each task separately and come back with more specific questions.
If I create an Outlook 2010 object In Excel VBA using
Sub CreateOL()
On Error Resume Next
Set myOlApp = GetObject(, "Outlook.Application")
If Err.Number = 429 Then
Set myOlApp = CreateObject("Outlook.Application")
End If
On Error GoTo 0
End Sub
Is it possible to force myOLAPP to send/receive. Please can somebody advise how it's done?
I've tried the following but it's not working for me.
Set nsp = myOlApp.GetNamespace("MAPI")
Set sycs = nsp.SyncObjects
For i = 1 To sycs.Count
Set syc = sycs.Item(i)
syc.Start
Next
Also, how do I make myOlApp visible? myOlApp.Visible = True and myOlApp.Application.Visible = True doesn't work
Thank you
Which Outlook version are you using? I tested this with Outlook 2010 and it works.
NOTE: I have not done any error handling. I am sure you can take care of that.
Public Sub Sample()
Dim oLook As Object
Dim nsp As Object, objSyncs As Object, objSync As Object
Dim i As Long
Set oLook = GetObject(, "Outlook.Application")
Set nsp = oLook.GetNamespace("MAPI")
Set objSyncs = nsp.SyncObjects
For i = 1 To objSyncs.Count
Set objSync = objSyncs.Item(i)
objSync.Start
Next
End Sub
MS Outlook has 2 types of windows
Explorer for Folders and
Inspector for individual items.
If you want to show a particular folder, you can start the Explorer for it then either use .Activate or .Display. An alternative would be to use MAPIFolder.Display method as well.