• This site uses cookies. By continuing to use this site, you are agreeing to our use of cookies. Learn more.

VB script in outlook form doesn't work anymore

Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
I used the following script for years in a customized outlook form to populate a combo box with outlook contacts. This worked fine until a couple of months ago. Now it doesn't work anymore.

Sub Item_Open()

Dim FullArray()

' Sets the name of page on the form (Termindetails)
Set FormPage = Item.GetInspector.ModifiedFormPages("Termindetails")

' Sets Control to a list box called ComboBox1.
Set Control = FormPage.Controls("ComboBox1")

' Get the default Contacts folder
Set ConFolder = Application.Session.GetDefaultFolder(10)

' Get the items in the folder
Set ConItems = ConFolder.Items

' Create a restrict filter
strFilter = "[Journal] = 1 "

' Just get those contacts with a Journal entry
set colResItems = ConItems.Restrict(strFilter)

' Sort the contacts based on LastName
colResItems.Sort "[LastName]"

' Get the number of total items in the Contacts folder
NumItems = colResItems.Count

' Sort the contacts based on LastName
' ConItems.Sort "[LastName]"

' Resize array to handle total number of item in the folder
ReDim FullArray(NumItems-1,4)

' Loop through all of the items in the Contacts folder,
' filling the array with sample data and keeping track
' of the number of contacts found.
NumContacts = 0
For I = 1 to NumItems
Set itm = colResItems(I)
If Left(itm.MessageClass, 11) = "IPM.Contact" Then
NumContacts = NumContacts + 1
FullArray(NumContacts-1,1) = itm.LastName
FullArray(NumContacts-1,2) = itm.User1
FullArray(NumContacts-1,3) = itm.CompanyName
FullArray(NumContacts-1,4) = itm.User2
End If

' Set the control to handle 4 data columns
Control.ColumnCount = 5

If NumItems = NumContacts Then
' They are all contacts, so use the FullArray
Control.List() = FullArray
' There's some distribution lists, so use the smaller
' ConArray to eliminate extra blank values in the list box
Dim ConArray()
ReDim ConArray(NumContacts-1,2)
For I = 0 to NumContacts - 1
ConArray(I,1) = FullArray(I,1)
ConArray(I,2) = FullArray(I,2)
Control.List() = ConArray
End If

End Sub