Solved: Outlook 2000 VBA Contact List

[TyrainDreams]

Hi Ive been perusing the forums here since i started my current job, im a programmer though i generally code in compiled languages PB/C/ASM(PIC,ARM,X86) for Windows and Linux platforms. I was recently given the task of creating something similiar to what Exchange does with outlook in that it syncs contacts to a database, we run a linux network so Exchange isn't an option, and were a linux zealot IT department :P so you know Microsoft is the devil and all that :), but its a neccesary evil.

Im going to follow the posted how to get help as much as possible post in the other subforum.

Version of the program
Outlook 2000 and Global Address Book whatever version number i assign it :D

What you want it to do
It needs to delete all contacts from a folder inside of the contacts folder and then download a csv file and make new contacts inside the folder.
-Contacts
-+Globab Address Book

Cell references, bookmark names, column letters, row numbers, worksheets, styles, whatever pertains to the information at handError messages if any
If not the entire code, then at least some of it

This is what im working with, its a mix of 2 code sources, one is from this forum, its for Outlook 2003 though. The delete subroutine works, it deletes the contacts in the folder perfectly. If i change "objContact.SaveAs (olMyContactsFolder)" to "objContact.Save" it saves perfectly to the Contacts folder(yeah great but not where i need it to go). It does save to the contacts folder so it is capable of loading a file off the url specified, for some reason it just wont save there properly. Its using a standard CSV contacts file simply to template it so i was working with all the same kinds of stuff.



Sub DeleteSpecialContacts()

Dim objOutlook As Outlook.Application
Dim olNS As Outlook.NameSpace
Dim olMyParentFolder As Outlook.MAPIFolder
Dim olMyContactsFolder As Outlook.MAPIFolder
Dim intCount As Integer
Dim objContact As ContactItem
Dim objDistList As DistListItem



Set objOutlook = CreateObject("Outlook.Application")
Set olNS = objOutlook.GetNamespace("MAPI")
Set olMyParentFolder = olNS.GetDefaultFolder(olFolderContacts)
Set olMyContactsFolder = olMyParentFolder.Folders("Global Address Book")



intCount = olMyContactsFolder.Items.Count

For i = intCount To 1 Step -1

Set olItem = olMyContactsFolder.Items(i)
Select Case olItem.Class

Case olContact
Set objContact = olMyContactsFolder.Items(i)
objContact.Delete
Case olDistributionList
Set objDistList = olMyContactsFolder.Items(i)
objDistList.Delete


End Select


Next

End Sub

Sub MakeContacts()

Dim objOutlook As Outlook.Application
Dim olNS As Outlook.NameSpace
Dim olMyParentFolder As Outlook.MAPIFolder
Dim olMyContactsFolder As Outlook.MAPIFolder
Dim intCount As Integer
Dim objContact As ContactItem
Dim objDistList As DistListItem
Const olContactItem = 2

Set objOutlook = CreateObject("Outlook.Application")
Set olNS = objOutlook.GetNamespace("MAPI")
Set olMyParentFolder = olNS.GetDefaultFolder(olFolderContacts)
Set olMyContactsFolder = olMyParentFolder.Folders("Global Address Book")

Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open("localhost/contacts.csv")

x = 2


Do Until objExcel.Cells(x, 2).Value = ""

Set objContact = objOutlook.CreateItem(olContactItem)
objContact.FullName = objExcel.Cells(x, 2).Value + " " + objExcel.Cells(x, 4).Value
objContact.CompanyName = objExcel.Cells(x, 6).Value
objContact.Email1Address = objExcel.Cells(x, 58).Value

objContact.SaveAs (olMyContactsFolder)

x = x + 1
Loop

objExcel.Quit
End Sub


Sample data (before and after sample worksheets, add as attachments here)
Heres an example line from the CSV file


,Alex,,Clay,,Columbus,IT,Systems Solutions Developer,,,,,,,,,,,,,,,,,,,,,,,,,,,,x4262,,,,,,,,,,,,,,,,,,,,,,notreal@fak e.inc,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
Politeness and gratitude :)
Thank you for providing such a wonderful forum for help and helping others who have issues with VBA

Mark your thread solved, when it has been, by hitting the Thread Tools dropdown at the top of the thread.
K, i will :D


Seriously though thank you for all of this I'll be checking this 10 times a day.

Alexander Clay

PS apparently when i was trying to post, it wouldnt allow me because of a link in the post, i guess this is in the code so im going to break it up a little bit so it can post...obviously not a real link...

[TyrainDreams]

bump

[Charlize]

The SAVEAS command will give an error because it's used for saving to a disk and not to a contactsfolder of outlook.

[TyrainDreams]

So is there no way to save to a specific folder?

[Charlize]

There must be an address book available in the public folders on the exchange server. Someone with administrator rights has created this and everyone has read/write access to this folder. Try next piece of coding to add contact to your personal contactsfolder and after the saving moves it directly to the business folder. NOT TESTED, so be carefull. Perhaps I will try this tomorrow during my lunchbreak.
Sub Save_Public_Contact()
'use outlook as instance
'why ? you are doing this in outlook or not ?
Dim myOlApp As Object
Dim myNamespace As Outlook.NameSpace
Dim myFolder As Outlook.MAPIFolder
Dim objContact As Outlook.ContactItem
Set myOlApp = CreateObject("Outlook.Application")
Set myNamespace = myOlApp.GetNamespace("MAPI")
Set myFolder = myNamespace.Folders("Public Folders")
Set myFolder = myFolder.Folders("All Public Folders")
'an address book folder in the public folder
'create by someone with administrator rights
'and everyone can have read/write acces to this folder
Set myFolder = myFolder.Folders("Business_Contacts")
'create outlook contactitem
Set objContact = myOlApp.CreateItem(olContactItem)
x = 2
objContact.FullName = objExcel.Cells(x, 2).Value + " " + objExcel.Cells(x, 4).Value
objContact.CompanyName = objExcel.Cells(x, 6).Value
objContact.Email1Address = objExcel.Cells(x, 58).Value
'save to your contactsfolder
objContact.Save
'move the contact to the addressbook in the public folders
objContact.Move myFolder
'Not sure if delete is needed when original entry is moved to
'business folder
objContact.Delete
End Sub
Charlize

[TyrainDreams]

We dont run an exchange server here, we have a linux network. The csv file is also generated from a database through a webpage.

[Charlize]

If the global address book is a subfolder of the default contactsfolder of your application, try this :Sub Save_Public_Contact()
'use outlook as instance
'why ? you are doing this in outlook or not ?
Dim myOlApp As Object
Dim myNamespace As Outlook.NameSpace
Dim myFolder As Outlook.MAPIFolder
Dim objContact As Outlook.ContactItem
Set myOlApp = CreateObject("Outlook.Application")
Set myNamespace = myOlApp.GetNamespace("MAPI")
'This is where you store your contacts
Set myFolder = myNamespace.GetDefaultFolder(olFolderContacts)
'This is a subfolder of contacts, named Global Address Book
Set myFolder = myFolder.Folders("Global Address Book")
'create outlook contactitem
Set objContact = myOlApp.CreateItem(olContactItem)
objContact.FullName = "Testing Name"
objContact.CompanyName = "Testing Company Name"
objContact.Email1Address = "Testing@ddress.com"
'save to your contactsfolder
objContact.Save
'move the contact to subfolder of default address book
objContact.Move myFolder
Set myOlApp = Nothing
End Sub
Charlize

ps.: There is no checking for double names.

[TyrainDreams]

You sir, are a god. The move makes the entire thing work. Thank you!!!:beerchug: