General discussion

Locked

Export Outlook Contacts to Excel without duplicates

By Av5480 ·
Below is the macro I created to export the outlook contacts into cells in Excel. Now I need a macro to open that Excel file and export the contacts from Outlook into it without duplicating the ones that have already been imported to Excel. Please help.

Sub ExportToExcel()
On Error Resume Next

Const olFolderContacts = 10

Set objOutlook = CreateObject("Outlook.Application")

Set objNamespace = objOutlook.GetNamespace("MAPI")

Set colContacts = objNamespace.GetDefaultFolder(olFolderContacts).Items

Set ObjExcel = CreateObject("Excel.Application")

ObjExcel.Visible = True

Set objWorkbook = ObjExcel.Workbooks.Add()

Set objWorksheet = objWorkbook.Worksheets(1)


ObjExcel.Cells(1, 1) = "Name"
ObjExcel.Cells(1, 2) = "Ref NO"
ObjExcel.Cells(1, 3) = "Company"
ObjExcel.Cells(1, 4) = "EMail 1"
ObjExcel.Cells(1, 5) = "EMail 2"
ObjExcel.Cells(1, 6) = "EMail 3"
ObjExcel.Cells(1, 7) = "WebSite"
ObjExcel.Cells(1, = "Tel #1"
ObjExcel.Cells(1, 9) = "Tel #2"
ObjExcel.Cells(1, 10) = "Cell"
ObjExcel.Cells(1, 11) = "Fax"
ObjExcel.Cells(1, 12) = "Address #1"
ObjExcel.Cells(1, 13) = "City #1"
ObjExcel.Cells(1, 14) = "State #1"
ObjExcel.Cells(1, 15) = "Zip #1"
ObjExcel.Cells(1, 16) = "Address #2"
ObjExcel.Cells(1, 17) = "City #2"
ObjExcel.Cells(1, 1 = "State #2"
ObjExcel.Cells(1, 19) = "Zip #2"
ObjExcel.Cells(1, 20) = "Well Name"
ObjExcel.Cells(1, 21) = "Orignator"
ObjExcel.Cells(1, 22) = "Operator"
ObjExcel.Cells(1, 23) = "Field"
ObjExcel.Cells(1, 24) = "Doc Type"
ObjExcel.Cells(1, 25) = "Lic #1"
ObjExcel.Cells(1, 26) = "S #1"
ObjExcel.Cells(1, 27) = "S #2"
ObjExcel.Cells(1, 2 = "P"


i = 2


For Each objContact In colContacts

ObjExcel.Cells(i, 1).Value = objContact.FullName
ObjExcel.Cells(i, 2).Value = objContact.JobTitle
ObjExcel.Cells(i, 3).Value = objContact.CompanyName
ObjExcel.Cells(i, 4).Value = objContact.Email1Address
ObjExcel.Cells(i, 5).Value = objContact.Email2Address
ObjExcel.Cells(i, 6).Value = objContact.Email3Address
ObjExcel.Cells(i, 7).Value = objContact.WebPage
ObjExcel.Cells(i, .Value = objContact.BusinessTelephoneNumber
ObjExcel.Cells(i, 9).Value = objContact.Business2TelephoneNumber
ObjExcel.Cells(i, 10).Value = objContact.MobilTelephoneNumber
ObjExcel.Cells(i, 11).Value = objContact.BusinessFaxNumber
ObjExcel.Cells(i, 12).Value = objContact.BusinessAddress
ObjExcel.Cells(i, 13).Value = objContact.BusinessAddressCity
ObjExcel.Cells(i, 14).Value = objContact.BusinessAddressState
ObjExcel.Cells(i, 15).Value = objContact.BusinessAddressPostalCode
ObjExcel.Cells(i, 16).Value = objContact.HomeAddress
ObjExcel.Cells(i, 17).Value = objContact.HomeAddressCity
ObjExcel.Cells(i, 1.Value = objContact.HomeAddressState
ObjExcel.Cells(i, 19).Value = objContact.HomeAddressPostalCode
ObjExcel.Cells(i, 20).Value = objContact.ManagerName
ObjExcel.Cells(i, 21).Value = objContact.ReferredBy
ObjExcel.Cells(i, 22).Value = objContact.User1
ObjExcel.Cells(i, 23).Value = objContact.OfficeLocation
ObjExcel.Cells(i, 24).Value = objContact.SchedulePlusPriority
ObjExcel.Cells(i, 25).Value = objContact.User2
ObjExcel.Cells(i, 26).Value = objContact.User3
ObjExcel.Cells(i, 27).Value = objContact.User4
ObjExcel.Cells(i, 2.Value = objContact.Sensitivity
i = i + 1

Next

Set objRange = objWorksheet.UsedRange

objRange.EntireColumn.AutoFit
End Sub

This conversation is currently closed to new comments.

0 total posts (Page 1 of 1)  
| Thread display: Collapse - | Expand +

All Comments

Back to Web Development Forum
0 total posts (Page 1 of 1)  

Related Discussions

Related Forums