Learn how to a build a cloud-first strategyRegister Now

  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 406
  • Last Modified:

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

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

Open in new window

  • 6
  • 5
1 Solution
PaulRKruegerAuthor Commented:
That's all interesting, but I'm afraid I don't have the skills to handle this one.
Chris BottomleyCommented:
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.

Windows Server 2016: All you need to know

Learn about Hyper-V features that increase functionality and usability of Microsoft Windows Server 2016. Also, throughout this eBook, you’ll find some basic PowerShell examples that will help you leverage the scripts in your environments!

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
Chris BottomleyCommented:
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 BottomleyCommented:
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?

Dim con
Dim olkApp
Dim fldr
Dim inputFile
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 

    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
        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
    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

Open in new window

PaulRKruegerAuthor Commented:
I'll play with it today.
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.  
Chris BottomleyCommented:
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.

PaulRKruegerAuthor Commented:
Here you go!

PaulRKruegerAuthor Commented:
Never mind! I changed the export to delineate using semicolons instead of commas and that did the trick.
Chris BottomleyCommented:
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.


Featured Post

Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

  • 6
  • 5
Tackle projects and never again get stuck behind a technical roadblock.
Join Now