I know this is an old chestnut and I must have spent 2 hours reading
previous posts on this subject without finding a solution.

I have all my contacts grouped into individual folders, and for the
most part switching to a customised view and copy/pasting data into
excel achieves what I need. Until now.

I now need to create a spreadsheet of a selection of contacts from any
particular folder, and export a select number of fields, including some
custom ones. After cannibalising more bits of code then I can start to
describe, and having my head stuck in Sue Mosher's excellent book for a
few days now I still am having problems getting my code to work.

What am trying to do is this:
When the code is launched, it works through the current folder only,
and filters out those contacts that have a custom filed 'IsLiveNow' set
to 'EE', then it exports a selection of fields from the contact to an
excel sheet.

The export bit works, it's the filtering IsLiveNow that is not
working.

Ideally I would like to have a button on the toolbar that opens a box
with options like: select the folder you want to export from, select
the filter to use, etc, then when the user click START it exports the
data for them without having to browse to the fodler in question, but
that can wait for the moment - getting the export working is more
urgent.

here it is:
========================================

Sub FilterToExcel()

   Dim objExcelApp
   Dim objExcelBook
   Dim objExcelSheets
   Dim objExcelSheet
   Dim objExcelRange
   Dim strRange
   Dim i
   Dim intTotalCount
   Dim intDoneCount
   Dim objApp
   Dim objFolder
   Dim objItems
   Dim objItem
   Dim strFilter

   Set objExcelApp = CreateObject("Excel.Application")
       objExcelApp.Workbooks.Open ("c:\Contacts.xls")
   Set objExcelBook = objExcelApp.ActiveWorkbook
   Set objExcelSheets = objExcelBook.Worksheets
   Set objExcelSheet = objExcelBook.Sheets(1)
       objExcelSheet.Activate
       objExcelApp.Application.Visible = True

   'Get Current Contacts folder

   Set objApp = CreateObject("Outlook.Application")
   Set objFolder = objapp.ActiveExplorer.CurrentFolder

   intTotalCount = objFolder.Items.Count

   strFilter = "[UserProperties(""IsLiveNow"") = ""EE"""

   For Each objItem In objFolder.Items.Restrict(strFilter)

       i = i + 1

       strRange = "A" & CStr(i)
       Set objRange = objExcelSheet.Range(strRange)
       If objItem.CompanyName <> "" Then objRange.Value =
objItem.CompanyName

       strRange = "B" & CStr(i)
       Set objRange = objExcelSheet.Range(strRange)
       If objItem.MailingAddress <> "" Then objRange.Value =
objItem.MailingAddress

       strRange = "C" & CStr(i)
       Set objRange = objExcelSheet.Range(strRange)
       If objItem.CustomerID <> "" Then objRange.Value =
objItem.CustomerID

       strRange = "D" & CStr(i)
       Set objRange = objExcelSheet.Range(strRange)
       If objItem.UserProperties("Exit1") <> "" Then objRange.Value =
objItem.UserProperties("Exit1")

       strRange = "E" & CStr(i)
       Set objRange = objExcelSheet.Range(strRange)
       If objItem.UserProperties("YearEnd") <> "" Then objRange.Value
= objItem.UserProperties("YearEnd")

       intDoneCount = intDoneCount + 1

       End If
       Next

       MsgBox intDoneCount & " of " & intTotalCount & " contacts
exported"

End Sub
===============================================
The reason I can no-longer copy/paste is because several of the fields,
including the mailing address field have the enter (chr(13)) code in
them and it messes everything up.

I hope one of you fine people can show me where I am going wrong...

Many thanks.