Hans Peter Christener
Member
- 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
Next
' 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
Else
' 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)
Next
Control.List() = ConArray
End If
End Sub
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
Next
' 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
Else
' 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)
Next
Control.List() = ConArray
End If
End Sub