VBS Contact Import to Public Folder

I am working on an import script based on several scripts I've found on here so far, but I need some help. The script already deletes all contact items in a public folder and I have the csv file with the information that needs to be loaded. Unfortunately I haven't been able to work out the import routine. I've removed my attempts so that they don't confuse the situation.

I need the information in the csv file loaded as outlook contacts. I would like the script to ignore contacts without an entry in the sn column. Lastly, I need this to be a standalone script (not an Outlook macro) as this will be an automated process.
Const olFolderContacts = 10
Const olPublicFoldersAllPublicFolders = 18 
Dim olkApp, olkSes, olkContacts, olkPublic, olkContact, intIndex
Set olkApp = CreateObject("Outlook.Application")
Set olkSes = olkApp.GetNamespace("MAPI")
olkSes.Logon "Outlook"
Set olkContacts = olkSes.GetDefaultFolder(olPublicFoldersAllPublicFolders).Folders("TBC Directory").Folders("TBC Directory")
'Delete all contacts
For intIndex = olkContacts.Items.count To 1 Step -1
       olkContacts.Items(intIndex).Delete
Next




Set olkContacts = Nothing
Set olkPublic = Nothing
Set olkContact = Nothing
olkSes.Logoff
Set olkSes = Nothing
Set olkApp = Nothing

Open in new window

contacts.csv
LVL 4
PaulRKruegerAsked:
Who is Participating?
 
Chris BottomleyConnect With a Mentor Software Quality Lead EngineerCommented:
See the following it works in my tests, (local rather than public folder) though one question is whether I have mapped the fields correctly - please check.

To use you need to modify the line:
Const FilePathandName = "C:\Users\Chris\Experts Exchange\contacts.csv"
to point to your csv

and the line:
        Set con = olkapp.Session.GetDefaultFolder(olPublicFoldersAllPublicFolders).Folders("TBC Directory").Folders("TBC Directory").items.Add
for your correct folder path

Nor did I want to delete my contacts so I have tried to copy that code across.  I trust you can work around the silly mistakes I probably made during the merger?

Chris
Dim con
Dim olkApp
Dim fldr
Dim inputFile
Dim FSO
Dim contactList
Dim contactArray
Dim arrItem
Dim entryCount
Dim itemCount
Dim itemArray
Dim arrtoFieldLookup()
Const FilePathandName = "C:\Users\Chris\Experts Exchange\contacts.csv"
const olFolderContacts = 10
Const olPublicFoldersAllPublicFolders = 18  
    
'Delete all contacts 
    For itemCount = olkContacts.Items.count To 1 Step -1 
        olkContacts.Items(itemCount).Delete 
    Next 

    Set FSO = CreateObject("scripting.filesystemobject")
    If FSO.FileExists(FilePathandName) Then
        Set inputFile = FSO.openTextFile(FilePathandName, 1, True)
        contactList = inputFile.ReadAll
        contactArray = Split(contactList, vbcrlf)
        Set inputFile = Nothing
    Else
        Set inputFile = Nothing
    End If
    Set FSO = Nothing
    For Each arrItem In Split(contactArray(0), ",")
        itemCount = itemCount + 1
        ReDim Preserve arrtoFieldLookup(itemCount + 1)
        Select Case arrItem
            Case "DisplayName"
                arrtoFieldLookup(itemCount) = "FullName"
            Case "department"
                arrtoFieldLookup(itemCount) = "Department"
            Case "facsimiletelephonenumber"
                arrtoFieldLookup(itemCount) = "BusinessFaxNumber"
            Case "givenname"
                arrtoFieldLookup(itemCount) = "FirstName"
            Case "mail"
                arrtoFieldLookup(itemCount) = "Email1Address"
            Case "mobile"
                arrtoFieldLookup(itemCount) = "MobileTelephoneNumber"
            Case "pager"
                arrtoFieldLookup(itemCount) = "PagerNumber"
            Case "physicaldeliveryofficename"
                arrtoFieldLookup(itemCount) = "BusinessAddressPostOfficeBox"
            Case "sn"
                arrtoFieldLookup(itemCount) = "LastName"
            Case "telephonenumber"
                arrtoFieldLookup(itemCount) = "PrimaryTelephoneNumber"
            Case "title"
                arrtoFieldLookup(itemCount) = "Title"
            Case "TBD"
                arrtoFieldLookup(itemCount) = ""
        End Select
    Next
    
    Set olkApp = CreateObject("Outlook.Application")
    For entryCount = LBound(contactArray) + 1 To UBound(contactArray)
        itemArray = Split(contactArray(entryCount), ",")
        Set con = olkapp.Session.GetDefaultFolder(olPublicFoldersAllPublicFolders).Folders("TBC Directory").Folders("TBC Directory").items.Add
        For itemCount = LBound(itemArray) To UBound(itemArray)
            'con.ItemProperties(arrtoFieldLookup(itemCount + 1)) = itemArray(itemCount)
        If itemArray(itemCount)<> "" then
	        Select Case arrtoFieldLookup(itemCount + 1)
	            Case "FullName"
	                con.FullName = itemArray(itemCount)
	            Case "Department"
	                con.Department = itemArray(itemCount)
	            Case "BusinessFaxNumber"
	                con.BusinessFaxNumber = itemArray(itemCount)
	            Case "FirstName"
	                con.FirstName = itemArray(itemCount)
	            Case "Email1Address"
	                con.Email1Address = itemArray(itemCount)
	            Case "MobileTelephoneNumber"
	                con.MobileTelephoneNumber = itemArray(itemCount)
	            Case "PagerNumber"
	                con.PagerNumber = itemArray(itemCount)
	            Case "BusinessAddressPostOfficeBox"
	                con.BusinessAddressPostOfficeBox = itemArray(itemCount)
	            Case "LastName"
	                con.LastName = itemArray(itemCount)
	            Case "PrimaryTelephoneNumber"
	                con.PrimaryTelephoneNumber = itemArray(itemCount)
	            Case "Title"
	                con.Title = itemArray(itemCount)
	            Case "TBD"
	                con.TBD = itemArray(itemCount)
	        End Select
	    End if
        Next
        con.Save
    Next

Open in new window

0
 
PaulRKruegerAuthor Commented:
That's all interesting, but I'm afraid I don't have the skills to handle this one.
0
Get expert help—faster!

Need expert help—fast? Use the Help Bell for personalized assistance getting answers to your important questions.

 
Chris BottomleySoftware Quality Lead EngineerCommented:
You have a csv with contact information and you want to upload the data as new contacts in the public folder "olkContacts " as you have instantiated above?

If yes can you produce a subset of the csv with dummy data for test purposes and to assist in understand datums required.

Chris
0
 
PaulRKruegerAuthor Commented:
Yes, that is correct. You can see a dummy file attached to the question (contacts.csv). The field mapping is as follows (csv column headings on left, Outlook fields on right):


   DisplayName   -> Email Display Name
department   -> Department
facsimiletelephonenumber   -> Business Fax
givenname   -> First Name
mail   -> Email Address
mobile   -> Mobile Phone
pager   -> Pager
sn   -> LAst Name
telephonenumber   -> Business Phone
title -> Job Title
0
 
Chris BottomleySoftware Quality Lead EngineerCommented:
Dummy file ... ah! sorry about that.

I will work on a solution in the morning if nothing happens in the meantime ... though I expect it will.

Chris
0
 
PaulRKruegerAuthor Commented:
I'll play with it today.
0
 
PaulRKruegerAuthor Commented:
OK, so I made one change (Title -> Job Title) and everything seems to work just fine.

                    Case "title"
                        con.JobTitle = itemArray(itemCount)

Unfortunately I'm having a problem with my larger data set. Some of our titles contain commas in them (e.g. "Vice President, CFO").

The CSV file has the title in quotation marks as seen above. Right now the script does one of two things:

1. It puts the part of the title before the comma in there ("Vice President)
2. The script fails because it thinks there are too many values for the array (e.g. "DIR OF MKTG-ACC,   WINE, REV MGT")

Is there anything that can be done to accommodate these titles? Ideally the full title without the quotes is what would end up in the Job Title field.  
0
 
Chris BottomleySoftware Quality Lead EngineerCommented:
MIght be able to bodge it a little ... can you supply a csv file with some representative albeit false data?

My theory is on examination that perhaps I can substitute the data for commas within quotes but before trying I want to know the data I am trying with has the potential to capture the issue.

Chris
0
 
PaulRKruegerAuthor Commented:
Here you go!

SampleData2.csv
0
 
PaulRKruegerAuthor Commented:
Never mind! I changed the export to delineate using semicolons instead of commas and that did the trick.
0
 
Chris BottomleySoftware Quality Lead EngineerCommented:
That's good ... a simple solution is much better ... I was in fact testing a solution when I had a PC crash so I am just rebooting teh now.

Chris
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.