How to Import a Comma Separated Value (CSV) File to Outlook with VBA

[erikheinrich]

Hello everyone,

I need some help optimizing a process for my company. We are a fast-growing company that has a very high client turnover, so it is pretty hard to keep database related issues up to date. For this reason, I started a VBA course to see if I could find a solution somehow. Right now I am trying to keep our distribution lists automatically updated. I have wrote a code to extract some .csv files from our database in excel and my challenge is how to import them into different distribution lists in Outlook.

I used to do this process manually, but we currently have 7 different .csv files, each representing a different distribution list and this would take up to an hour a day to be done.

This is how the manual process goes:

- Import the first .csv file into a specific contact folder, mapping the name and e-mail in its respective fields;
- Create a new distribution list for the contacts that were just imported, import them into it and save as a name of choice;
- Delete contacts from the specific contact folder that they were imported to;
- Repeat the same process for the next .csv file.

Is there any way someone could point me in the right direction here? I just need to import two different fields: name (first and last name together) and e-mail address.

Thanks in advance!

Erik

[gmayor]

The following will read the CSV named in the macro (strFilename) line by line into a named distribution list (strDistListName) in the default contacts list (olFolder).

If the named list exists the names are appended. You can modify it to use another contacts folder as required.


Option Explicit

Sub DistListCreate()
'Graham Mayor - http://www.gmayor.com - 28/09/2016

'Assuming file looks like this. File path: D:\Path\Example\Outlook DistList Example.csv
'Name, Address
'John Smith, john@somewhere.com

Dim vTextData As Variant
Dim strTextRow As String
Dim iFileNo As Integer
Dim iCount As Integer: iCount = 1

Const strFileName As String = "D:\Path\Example\Outlook DistList Example.csv"
Const strDistListName As String = "A_Test"

iFileNo = FreeFile 'Get first free file number

Open strFileName For Input As #iFileNo
Do While Not EOF(iFileNo)
Line Input #iFileNo, strTextRow
vTextData = Split(strTextRow, Chr(44))
If iCount > 1 Then
'Debug.Print vTextData(0) & " (" & vTextData(1) & ")"
CreateDistributionList strDistListName, vTextData(0) & " (" & vTextData(1) & ")"
End If
iCount = iCount + 1
Loop
Close #iFileNo
lbl_Exit:
Exit Sub
End Sub

Private Function CreateDistributionList(strListName As String, strMember As String)
'Graham Mayor - http://www.gmayor.com - 28/09/2016
'strMember should be in the format "Name (e-mail address)"
Dim olNS As Outlook.NameSpace
Dim olFolder As Outlook.Folder
Dim olDistList As Outlook.DistListItem
Dim olFolderItems As Outlook.Items
Dim objRcpnt As Outlook.Recipient
Dim x As Integer
Dim y As Integer
Dim iCount As Integer
Dim bList As Boolean
Dim bMember As Boolean

Set olNS = GetNamespace("MAPI")
Set olFolder = olNS.GetDefaultFolder(olFolderContacts)
Set olFolderItems = olFolder.Items
bList = False
bMember = False
iCount = olFolderItems.Count
For x = 1 To iCount
If TypeName(olFolderItems.Item(x)) = "DistListItem" Then
Set olDistList = olFolderItems.Item(x)
'Check if the distribution list exists
If olDistList.DLName = strListName Then
bList = True
For y = 1 To olDistList.MemberCount
'Check if the member exists
If InStr(1, olDistList.GetMember(y).Name, strMember) Then
bMember = True
Exit For
End If
Next y
End If
End If
Next x
'If the distribution list doesn't exist - add it
If Not bList Then
Set olDistList = CreateItem(olDistributionListItem)
olDistList.DLName = strListName
End If
'If the member doesn't exist add it
If Not bMember Then
Set objRcpnt = olNS.CreateRecipient(strMember)
objRcpnt.Resolve
olDistList.AddMember objRcpnt
End If
'Save the change to the list
olDistList.Save
lbl_Exit:
Set olNS = Nothing
Set olFolder = Nothing
Set olDistList = Nothing
Set olFolderItems = Nothing
Set objRcpnt = Nothing
Exit Function
End Function