Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations sizbut on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Using VBA in Excel to extract Outlook Data

Status
Not open for further replies.

DrMingle

Technical User
May 24, 2009
116
US
I am looking to use Excel to copy the data from one specific folder in Outlook and past in an Excel spreadsheet.

A few issues I have a custom form which has been used in Outlook to collect the data (user defined fields).

Additionally I am not sure how exactly I would need to use VBA in Excel to pull this off.

I have borrowed this snippet with the exception of importating "contacts" I think it is a fair skeleton to work off of...

Let me know your thoughts.

Code:
Sub ImportContactsFromOutlook()

   ' This code is based in Microsoft Access.

   ' Set up DAO objects (uses existing "tblContacts" table)
   Dim rst As DAO.Recordset
   Set rst = CurrentDb.OpenRecordset("tblContacts")


   ' Set up Outlook objects.
   Dim ol As New Outlook.Application
   Dim olns As Outlook.Namespace
   Dim cf As Outlook.MAPIFolder
   Dim c As Outlook.ContactItem
   Dim objItems As Outlook.Items
   Dim Prop As Outlook.UserProperty

   Set olns = ol.GetNamespace("MAPI")
   Set cf = olns.GetDefaultFolder(olFolderContacts)
   Set objItems = cf.Items
   iNumContacts = objItems.Count
   If iNumContacts <> 0 Then
      For i = 1 To iNumContacts
         If TypeName(objItems(i)) = "ContactItem" Then
            Set c = objItems(i)
            rst.AddNew
            rst!FirstName = c.FirstName
            rst!LastName = c.LastName
            rst!Address = c.BusinessAddressStreet
            rst!City = c.BusinessAddressCity
            rst!State = c.BusinessAddressState
            rst!Zip_Code = c.BusinessAddressPostalCode
            ' Custom Outlook properties would look like this:
            ' rst!AccessFieldName = c.UserProperties("OutlookPropertyName")
            rst.Update
         End If
      Next i
      rst.Close
      MsgBox "Finished."
   Else
      MsgBox "No contacts to export."
   End If

End Sub

Any help would be appreciated.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top