script delete old contacts and add from csv

[projector1]

every year around this time we get a large number of calls for staff who would like the new staff emails added to their outlook contacts. We do not have an exchange server and all staff have office 2003 installed.
I add the new staff to a csv file i created that is compatible with outlook 2003.
what i need the script to do is delete any emails contacts that end with @abc.co.uk and then adds the contacts that are in the csv file.
I bought a load of vb books two years ago, however last year i develop severve RSI thus cannot make full use of the books i invested in.

Many thanks

 

[ClulessChris]

Take a look at regex, shoul do just the job

Never knock on Death's door: ring the bell and run away! Death really hates that!

 

[projector1]

managed to find this, any body kind enough to examine it to see if it is the correct syntax?

Sub ContactsImport()

Dim olApp As Outlook.Application
Dim myNameSpace As Outlook.NameSpace
Dim objFolder As Outlook.MAPIFolder
Dim objItems As Outlook.Items

Dim sPathInp As String
Dim sFNameInp As String
Dim i As Integer
Dim lastline As Boolean
Dim F As Outlook.MAPIFolder
Dim sContactFolder As String

Dim oContact As Outlook.ContactItem
Dim sTestUsers As String
Set olApp = CreateObject("Outlook.Application")

Set myNameSpace = olApp.GetNamespace("MAPI")

sPathInp = "C:\import\" ' path where csv file is saved to
sFNameInp = "Infra phone numbers.csv" 'name of csv file
sTestUsers = "@test.co.uk"

lastline = False
i = 1

Set F = myNameSpace.GetDefaultFolder(olFolderContacts)

sContactFolder = "Contacts" 'change to the name of the new contact folder you want to create'

If sContactFolder = "Contacts" Or IsMissing(sContactFolder) Or sContactFolder = "" Then
Set objFolder = myNameSpace.GetDefaultFolder(olFolderContacts)
Else
Set objFolder = myNameSpace.GetDefaultFolder(olFolderContacts).Folders(sContactFoldere)
End If

objFolder.ShowAsOutlookAB = True ' ticks box to see folder content items as contact'




'Set objItems = objFolder.Items'
'delete test users'
For Each oContact In objFolder.Items
If InStr(oContact.Email1Address, sTestUsers) > 1 Then
oContact.Delete
End If
Next

' Read a Comma Separated Values file'

Const ForReading = 1

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objtextFile = objFSO.OpenTextFile(sPathInp & "\" & sFNameInp, ForReading)

Do While objtextFile.AtEndOfStream <> True
strline = objtextFile.ReadLine
If InStr(strline, ",") Then
arrrecord = Split(strline, ",")
'----need to find the format of csv----'
Wscript.Echo arrrecord.Count, strline
Wscript.Echo "A: " & arrrecord(1)
Wscript.Echo "B: " & arrrecord(2)
Wscript.Echo "C: " & arrrecord(3)
Wscript.Echo "D: " & arrrecord(4)
Wscript.Echo "E: " & arrrecord(5)
Wscript.Echo "F: " & arrrecord(6)
i = i + 1
Set objItems = objFolder.Items

Set objadd = objItems.Add 'creates a new contact'

With objadd 'adds the following details to the new contact'
.FirstName = arrrecord(2)
.LastName = arrrecord(3)
.BusinessTelephoneNumber = arrrecord(4)
.MobileTelephoneNumber = arrrecord(5)
.Email1Address = arrrecord(6)
.FileAs = arrrecord(2) & " " & arrrecord(3)
.Save
End With

End If
Loop

Set objItems = Nothing
Set objFolder = Nothing
Set myNameSpace = Nothing
Set olApp = Nothing

End Sub