Thread: Excel data export to Outlook 2007 contact list using VBA

Hi Guys,
I have following queries regarding Outlook 2007 contact management .I am trying to export excel format using the following code to outlook 2007,contacts list, but its not working ..can someone assist me in sorting this out ..i am attaching the format i need to export and here is the code i am using

Dim appOutlook As Outlook.Application
Dim objNameSpace As Outlook.Namespace
Dim objContactFolder As Outlook.MAPIFolder
Dim objContacts As Outlook.ContactItem
'Dim myDistList As Outlook.DistListItem
Sub ContList()
 
Set appOutlook = GetObject(, "Outlook.Application")
Set objNameSpace = appOutlook.GetNamespace("MAPI")
Set objContactFolder = objNameSpace.GetDefaultFolder(olFolderContacts)
Set myMailItem = appOutlook.CreateItem(olMailItem)
Set myRecipients = myMailItem.Recipients
'Set myDistList = appOutlook.CreateItem(olDistributionListItem)
For i = 3 To Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Set objContacts = objContactFolder.Items.Add(olContactItem)
With objContacts
    '.Secs = Range("B" & i).Value '.CompanyName = Range("B" & i).Value
    .BusinessName = Range("C" & i).Value '.LastName = Range("C" & i).Value
    .ContactName = Range("D" & i).Value '.FirstName = Range("D" & i).Value
    .Custemail = Range("E" & i).Value '.BusinessAddress = Range("E" & i).Value
    .Traderemail = Range("F" & i).Value '.BusinessAddressCity = Range("F" & i).Value
    .salesemail = Range("G" & i).Value '.BusinessAddressState = Range("G" & i).Value
    .BusinessAddressPostalCode = Range("H" & i).Value
    .BusinessAddressCountry = Range("I" & i).Value
    .JobTitle = Range("J" & i).Value
    .BusinessTelephoneNumber = Range("K" & i).Value
    .BusinessFaxNumber = Range("L" & i).Value
    .Email1Address = Range("E:G" & i).Value '.Email1Address = Range("M" & i).Value
    .Body = Range("N" & i).Value
    .Save
End With
 
    myRecipients.Add (Range("E" & i).Value)
 
 
   Next
 
   myRecipients.ResolveAll
   myDistList.AddMembers myRecipients
   myDistList.Display
 
End Sub

I have posted the same query on the following link as well: http://forums.techguy.org/business-a...ml#post7797407

Regards

Nutti ,nice to see you .
First , when you play it with outlook and macro's > the references !! Microsoft Outlook 12.0 Object library ( for outlook 2007 , 14.0 is 2010 )
second , do not change the the header names .
third , i'm test it with this part of your code .
look to the jpeg .( my outlook is Dutch ) but you can see the data .
When you will test it , do it with 4 a 5 customers , if it's wrong >>>> clean up your contacts in outlook ( max . 5 people )

Sub ContList()

Dim appOutlook As Outlook.Application
Dim objNameSpace As Outlook.Namespace
Dim objContactFolder As Outlook.MAPIFolder
Dim objContacts As Outlook.ContactItem
Dim myDistList As Outlook.DistListItem

Set appOutlook = GetObject(, "Outlook.Application")
Set objNameSpace = appOutlook.GetNamespace("MAPI")
Set objContactFolder = objNameSpace.GetDefaultFolder(olFolderContacts)
Set myMailItem = appOutlook.CreateItem(olMailItem)
Set myRecipients = myMailItem.Recipients
Set myDistList = appOutlook.CreateItem(olDistributionListItem)
For i = 3 To Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Set objContacts = objContactFolder.Items.Add(olContactItem)
With objContacts
    .CompanyName = Range("B" & i).Value
    .LastName = Range("C" & i).Value
    .FirstName = Range("D" & i).Value
    .BusinessAddress = Range("E" & i).Value
    .BusinessAddressCity = Range("F" & i).Value
    .BusinessAddressState = Range("G" & i).Value
    .BusinessAddressPostalCode = Range("H" & i).Value
    .BusinessAddressCountry = Range("I" & i).Value
    .JobTitle = Range("J" & i).Value
    .BusinessTelephoneNumber = Range("K" & i).Value
    .BusinessFaxNumber = Range("L" & i).Value
    .Email1Address = Range("M" & i).Value
    .Body = Range("N" & i).Value
    .Save
End With
 
    'myRecipients.Add (Range("E" & i).Value)
 
 
   Next
 
   myRecipients.ResolveAll
   myDistList.AddMembers myRecipients
   'myDistList.Display
 
End Sub

Hey T,
When I am tryin to run the code I am gettin error in

For i = 3 To Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

..Runtime error 1004 ..
2/ Do i have to update the contact list to a specefic format
3/ How to decide which code is to be run in outlook as I am confused ..
I ran this code in outlook ...Hey wat are ur plan for the week ends ..
awaiting inputs
Regards

Hoi Nutty , weekend is rest I'll post an example .
when you start to search , into the second row then in the macro ( For i = 2 To Cells.Find ) if you start on row six >> then ( For i = 6 To Cells.Find )
Only run the code in the Excel Workbook

Originally Posted by trucker10

Hoi Nutty , weekend is rest I'll post an example .
when you start to search ,

Good to see you T10 ...I will go throught he code and let you know ...Meanwhile can you help me resolve two more queries ..
1/ I want to attach excel file to outlook as an attachment .
2/ I also want to copy the contents of the attachment in the mail .
Regards

I post a quick example of how it can ( " Dutch sheets and text " ) , but i go to bed .
Take a look to the code

Originally Posted by trucker10

I post a quick example of how it can ( " Dutch sheets and text " ) , but i go to bed .
Take a look to the code

Hey T ,
I understand not a thing ...Guess it is due to lack of my VB knowledge ,can you explain ...When u come on line PM me so that i can be with you ..Dont worry abt the time I will be available at your conveniance...
Regards
N