Trying to automate searching Outlook's address book and need optimization tips->
Hi,
Looking for a way to quickly find e-mail addresses associated with a contact's name I wrote a program to do exactly this and it works fine except for the fact that when dealing with an addressbook containing 70000 or so contacts it's so slow that it takes several minutes to read the addressbook or to go through all the contacts collected to find an e-mail address.
When the user selects an addressbook or an address entry type (Outlook.OlAddressEntryUserType) it collects all contacts that meet the criteria using the following code:
Code:
e.Result = (From Contact In .OutlookO.GetNamespace("MAPI").AddressLists(.AddressList).AddressEntries Where DirectCast(Contact, Outlook.AddressEntry).AddressEntryUserType = .AddressType Select DirectCast(Contact, Outlook.AddressEntry)).ToArray()
"e.Result" refers to return value for the backgroundworker object used to execute the above code.
"ContactsSource.Contacts" refers to an Outlook.AddressEntry array that is part of the public ContactsSource structure.
Code:
Dim EMailAddresses As New List(Of String)
Dim FirstContact As Outlook.AddressEntry = Nothing
Name = Name.Trim()
If ContactsSource.Contacts.Count > 0 Then
FirstContact = ContactsSource.Contacts.First
If FirstContact.GetContact() IsNot Nothing Then
For Each Contact As Outlook.AddressEntry In From ContactO In ContactsSource.Contacts Where ContactO.GetContact().FullName.IndexOf(Name, StringComparison.CurrentCultureIgnoreCase) > -1
With Contact.GetContact()
EMailAddresses.AddRange({ .Email1Address, .Email2Address, .Email3Address})
End With
Next Contact
ElseIf FirstContact.GetExchangeDistributionList() IsNot Nothing Then
For Each Contact As Outlook.AddressEntry In From ContactO In ContactsSource.Contacts Where ContactO.GetExchangeDistributionList.Name.IndexOf(Name, StringComparison.CurrentCultureIgnoreCase) > -1
EMailAddresses.Add(Contact.GetExchangeDistributionList.PrimarySmtpAddress)
Next Contact
ElseIf FirstContact.GetExchangeUser() IsNot Nothing Then
For Each Contact As Outlook.AddressEntry In From ContactO In ContactsSource.Contacts Where ContactO.GetExchangeUser.Name.IndexOf(Name, StringComparison.CurrentCultureIgnoreCase) > -1
EMailAddresses.Add(Contact.GetExchangeUser.PrimarySmtpAddress)
Next Contact
End If
Does any one here know how to optimize the code so that it only takes seconds instead of minutes to go through a large number contacts? Any help would be appreciated.
The full program code has been attached to this post as Sea.zip.
Thanks in advance.
Re: Trying to automate searching Outlook's address book and need optimization tips->
You will suffer a performance hit when using LINQ. Generally speaking, it is not that big of a deal but when you're working with that many values then yeah... it's noticeable. My first suggestion would be to see if you see an immediate relief when you use a For/Next loop instead. I've never worked with this namespace, but here is some pseudo code (that may or may not work):
Code:
'Get all of the entries
Dim entries As AddressEntries = .OutlookO.GetNamespace("MAPI").AddressLists(.AddressList).AddressEntries
'Create a list to store the entries that are AddressType
Dim addresses As New List(Of Outlook.AddressEntry)
'Placeholder variable for the entry
Dim entry As AddressEntry
'Iterate through the collection
For index As Integer = 0 To entries.Count - 1
'Assign the value of the placeholder
entry = DirectCast(entries.Item(index), Outlook.AddressEntry)
'Check if it is an AddressType
If entry.AddressEntryUserType = .AddressType
'Add it to the collection
address.Add(entry)
End If
Next
Re: Trying to automate searching Outlook's address book and need optimization tips->
Quote:
Originally Posted by
dday9
You will suffer a performance hit when using LINQ. Generally speaking, it is not that big of a deal but when you're working with
that many values then yeah... it's noticeable. My first suggestion would be to see if you see an immediate relief when you use a For/Next loop instead. I've never worked with this namespace, but here is some pseudo code (that may or may not work):
Code:
'Get all of the entries
Dim entries As AddressEntries = .OutlookO.GetNamespace("MAPI").AddressLists(.AddressList).AddressEntries
'Create a list to store the entries that are AddressType
Dim addresses As New List(Of Outlook.AddressEntry)
'Placeholder variable for the entry
Dim entry As AddressEntry
'Iterate through the collection
For index As Integer = 0 To entries.Count - 1
'Assign the value of the placeholder
entry = DirectCast(entries.Item(index), Outlook.AddressEntry)
'Check if it is an AddressType
If entry.AddressEntryUserType = .AddressType
'Add it to the collection
address.Add(entry)
End If
Next
Hi,
Thank you for the quick reply. I completely removed the usage of LINQ (with the exception of a few references to .Distinct and .Count). At the moment I don't have access (and won't until next tuesday) to an Outlook addressbook with several thousand contacts. Could some one who does have access to such a large addressbook test the attached update and time how long it takes to run?
Thanks.
Re: Trying to automate searching Outlook's address book and need optimization tips->
Hi Peter,
I would read the Contacts to a Database, but this might help anyway
Code:
Imports Outlook
Public Class Form3
Private Sub Form3_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
ListView1.View = View.Details
ListView1.Columns.Add("Name", 150, HorizontalAlignment.Left)
ListView1.Columns.Add("Email", 250, HorizontalAlignment.Left)
'add more...
End Sub
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim outlookApplication As Outlook.Application = New Outlook.Application()
Dim oNS As Outlook.NameSpace = outlookApplication.GetNamespace("mapi")
oNS.Logon("Outlook", Reflection.Missing.Value, False, True)
Dim oContacts As Outlook.MAPIFolder = oNS.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderContacts)
Dim objItems = oContacts.Items
For i As Integer = 1 To oContacts.Items.Count
Dim contact = DirectCast(objItems.Item(i), ContactItem)
'search for a Lastname
' If contact.LastName.Contains("Swinkels") Then
Dim lvi As ListViewItem = New ListViewItem(contact.Email1DisplayName)
lvi.SubItems.Add(contact.Email1Address)
'add more Data....
'add to Listview or to a Database Table
ListView1.Items.Add(lvi)
' End If
Next i
oNS = Nothing
objItems = Nothing
outlookApplication = Nothing
End Sub
regards
Chris
Re: Trying to automate searching Outlook's address book and need optimization tips->
Hi Peter,
as I will need something like this in the future, I gave it some more thought.
It will be better to use the OLEDB to search and Filter what you want. There are still some
loose ends like..
the export to the Database , all Fileds have a lenght of 255 Characters.
here what I have got so far.
there is no need to reference Outlook
sorry, you will have to translate to Englisch values
Code:
Imports System.Data.OleDb
'no need to reference Outlook, you just need the OLEDB
Public Class Form1
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
txtFolderName.Text = "Persönliche Ordner" ' probably "Personel Folder"
txtProfile.Text = "Outlook"
End Sub
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
' Build the connection string.
Dim connectionString As String = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Outlook 9.0;" & "MAPILEVEL=" & txtFolderName.Text & _
"|;" & "PROFILE=" & txtProfile.Text & ";" & _
"TABLETYPE=0;" & "DATABASE=" & System.IO.Path.GetTempPath()
'you might have to change the above to : Exchange 4.0; instead of Outlook 9.0;
'Build your search string(s)
Dim sSQL As String = "SELECT Vorname, Nachname,[E-Mail-Adresse] FROM Kontakte"
Dim sWhere As String = Nothing
If TextBox1.Text <> Nothing Then
sWhere &= "And (Vorname Like '" & TextBox1.Text & "%') "
End If
If TextBox2.Text <> Nothing Then
sWhere &= "And (Nachname Like '" & TextBox2.Text & "%') "
End If
If sWhere <> Nothing Then
sWhere = " Where " & sWhere.Substring(4)
End If
sSQL &= sWhere & " Order by Nachname"
'check your Sql-String with MsgBox
'MsgBox(sSQL)
' Create the DataAdapter.
Dim da As New OleDbDataAdapter(sSQL, connectionString)
' Create and fill the table.
Dim dt As New DataTable("Kontakte")
Try
da.Fill(dt)
DataGridView1.DataSource = dt.DefaultView
DGVColumsAutoSize(True)
Catch ex As EvaluateException
MessageBox.Show("ERROR: " + ex.Message)
Return
End Try
End Sub
Private Sub DataGridView1_DataBindingComplete(ByVal sender As System.Object, ByVal e As System.Windows.Forms.DataGridViewBindingCompleteEventArgs) Handles DataGridView1.DataBindingComplete
'Format the Emailaddress
For Each r As DataGridViewRow In DataGridView1.Rows
r.Cells("E-Mail-Adresse") = New DataGridViewLinkCell()
Dim c As DataGridViewLinkCell = TryCast(r.Cells("E-Mail-Adresse"), DataGridViewLinkCell)
Next
End Sub
Private Sub DataGridView1_CellContentClick(ByVal sender As System.Object, ByVal e As System.Windows.Forms.DataGridViewCellEventArgs) Handles DataGridView1.CellContentClick
'use the Emailaddress to write a new Email
If TypeOf DataGridView1.Rows(e.RowIndex).Cells(e.ColumnIndex) Is DataGridViewLinkCell Then
Process.Start("mailto:" + DataGridView1.Rows(e.RowIndex).Cells(e.ColumnIndex).Value)
End If
End Sub
Public Sub DGVColumsAutoSize(ByVal AutoSize As Boolean)
If DataGridView1 Is Nothing Then
Exit Sub
End If
Dim ColumnMode As DataGridViewAutoSizeColumnMode
If AutoSize Then
ColumnMode = DataGridViewAutoSizeColumnMode.AllCells
Else
ColumnMode = DataGridViewAutoSizeColumnMode.None
End If
With DataGridView1
For i As Integer = 0 To .Columns.Count - 1
.Columns(i).AutoSizeMode = ColumnMode
Next
End With
End Sub
Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
' Build the connection string.
Dim connectionString As String = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Outlook 9.0;" & "MAPILEVEL=" & txtFolderName.Text & _
"|;" & "PROFILE=" & txtProfile.Text & ";" & _
"TABLETYPE=0;" & "DATABASE=" & System.IO.Path.GetTempPath()
'send the Data to a new Table in Access
Dim sSQL As String = "SELECT * INTO MyKontakte IN 'c:\TestData.mdb' FROM Kontakte;"
'Create the DataAdapter.
Dim da As New OleDbDataAdapter(sSQL, connectionString)
' Create and fill the table.
Dim dt As New DataTable("Kontakte")
da.Fill(dt)
End Sub
regards
Chris
