Link to home
Start Free TrialLog in
Avatar of Bandolier
Bandolier

asked on

VBA Mass Update of Contact Telepohone Numbers

Moved on from my Excel VBA exploits to tackle an Outlook issue.  I have 4,000 contacts and need to reformat them so that my new Nokia phone recognises the numbers correctly. Basically I need to drop the zeros after any (+44 UK) country dial code entry.

First thing I am struggling with is the Restrict method, where I am trying to select only NULL data for update.
Second thing is in using the For Next loop, which does not loop through all the contacts. When I modify a contact and .Save the order is changed.  I cannot find a way to control it.  e.g. select and index and mmove through the records etc.  Is there an easy way to monitor what is happening?

A snippet of relevant code and the outline fix proceedure:

Thanks for any help you can offer.

Cheers

Bandolier
' set up the items filter
CheckCountry = "IsNull([BusinessAddressCountry])"
' line above does not work, but is what I want!
'
' CheckCountry = "[BusinessAddressCountry] <> '" & "" & "'"""
' works but does not give me what I want!
'
' Set olkItems = olkFolder.Restrict(IsNull("[businessaddresscountry]"))
'the direct appraoch but line above does not work
 
' Set olkItems = olkFolder.Restrict("[BusinessAddressCountry] <> '" & "" & "'")
' another try - but I do not understand the delimiting too well
'
Set olkItems = olkFolder.Restrict(CheckCountry)
For Each olkContact In olkItems
  With olkContact
     olkContact.BusinessAddressCountry = FixCountry _  
        (olkContact.BusinessAddressCountry, _ 
           Trim(Left(olkContact.BusinessTelephoneNumber, 4)))
     If NeedToSave Then
          olkContact.Save
          NeedToSave = False
     End If
   End With
Next
 
 
 
Function FixCountry(Country As String, Code As String)
    NeedToSave = False
    If Country <> "" And Country <> " " Then
        FixCountry = Country
        NeedToSave = False
        Exit Function
    End If
    If Code = "" Or Code = " " Then
        FixCountry = Country
        NeedToSave = False
        Exit Function
    End If
    Select Case Left(Code, 3)
        Case Is = "+44"
            FixCountry = "United Kingdom"
            NeedToSave = True
        Case Is = "+33"
            FixCountry = "France"
            NeedToSave = True
        Case Is = "+49"
            FixCountry = "Germany"
            NeedToSave = True
        Case Is = "+31"
            FixCountry = "Netherlands"
            NeedToSave = True
        Case Is = "+46"
            FixCountry = "Sweden"
            NeedToSave = True
        Case Is = "+41"
            FixCountry = "Switzerland"
            NeedToSave = True
        Case Is = "+39"
            FixCountry = "Italy"
            NeedToSave = True
    '    Case "+353"
     '       FixCountry = "Ireland"
      '      NeedToSave = True
        Case Is = "+34"
            FixCountry = "Spain"
            NeedToSave = True
        Case Is = "+1 "
            FixCountry = "United States of America"
            NeedToSave = True
        Case Else
            FixCountry = "United Kingdom"
           NeedToSave = True
    End Select
 
End Function

Open in new window

Avatar of David Lee
David Lee
Flag of United States of America image

Hi, Bandolier.

"Second thing is in using the For Next loop, which does not loop through all the contacts. When I modify a contact and .Save the order is changed."

Loop through the items backwards.  Instead of

    For Each Item in Collection

use

    For x = Collection.Count to 1 Step -1
        Set Item = Collection.Items.Item(x)

Working backwards means that any change affecting the entire collection doesn't disturb the order of unprocessed items.

Is to the Restrict, try this

   Items.Restrict("[BusinessAddressCountry] <= ' '")
Avatar of Bandolier
Bandolier

ASKER

Hi BDF,

OK, thanks.

So only working through them backwards results in correct manipulation of the unprocessed items?

What does the <= ' ' actually mean?

I will try out your suggestions ASAP and report back as the 2003 files are on the laptop.  Unfortunately my wife's new puppy dog chewed through the laptop lead last night, so I cannot power it up!  Awaiting replacement lead ordered from eBay.

Cheers

Bandolier
"So only working through them backwards results in correct manipulation of the unprocessed items?"
If the processing will result in changes to the list, then yes.  Consider a list like the following

    Item 1
    Item 2
    Item 3   <- Current Item
    Item 4
    Item 5

The list represents the results of a Restrict operation that has returned all the items where field X is blank.  Your code makes a change to the current item, Item 3, that puts a value into field X.  Item 3 no longer belongs in the list because it doesn't meet the condition of the Restrict.  So, it falls out of the list.  When it does that all the items after it shuffle down one position.  The result is a list that looks like this

    Item 1
    Item 2
    Item 4  <- Current Item
    Item 5

Keep in mind that the FOR EACH operation is using an index.  That index was pointing to the third item in the list.  It doesn't care that the third item is now Item 4.  When the code hits the NEXT operation the process grabs the next item in line, Item 5.  This means that Item 4 never gets processed.  Working through the items backwards prevents this, because changes to the list always occur at the end and therefore don't affect the order.  Moving forward through the list is fine so long as the code doesn't cause any item to fall out of the list, either because of a change or a deletion.  

LOL.  I have a cat that likes to chew cords, so I've experienced the same sort of thing.
Thanks for the tutorial DBF.  That helps a lot!
Any thoughts on "What does the <= ' ' actually mean"
Cheers
Bandolier
Less than or equal to nothing.
What's less than nothing?
Cannot work this out BDF.
Messing around before I change my live data.
All BusinessAddressCountry fields given a country, manually.
Set olkItems = olkFolder.Restrict("[BusinessAddressCountry] <= ' '") gives me 0 contacts - Seems OK, there are none.
Set olkItems = olkFolder.Restrict("[BusinessAddressCountry] >= ' '") gives me 3497 contacts - That's OK
Add a new contact, changing only firstname, company.  BusinessAddressCountry is set to none by Outlook.
Set olkItems = olkFolder.Restrict("[BusinessAddressCountry] <= ' '") still gives me 0 contacts!  Should now be 1
Adding a single space to the new contact BusinessAddressCountry field
Set olkItems = olkFolder.Restrict("[BusinessAddressCountry] <= ' '") gives me 1 contacts.

So how do I get hold of contacts where the BusinessAddressCountry field is set to none?

Cheers

Bandolier
Is there a space between the two apostrophes?  If not, there should be.
There is.  
Also trying to restrict items to telephone number fields that are not empty but getting blank fields passed through.  Using "[BusinessTelephoneNumber] <> ' '" or "[BusinessTelephoneNumber] <> ''"
Arrgh!
Not like good old Foxpro!
ASKER CERTIFIED SOLUTION
Avatar of David Lee
David Lee
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
I have just run this code on my live contacts data.  Largely UK numbers but some international.   It worked a treat.  I did modifty the country codes beforehand and will post that code snippet later.

A big thank you to BDF for his expert help and advice.  Much appreciated mate!

Now going to modify my FileAs fields to Company, Lastname, Firstname and already see that BDF has posted an outline solution to that promblem.  Thanks for that.

Cheers

Martyn
Sub FixPhoneNumbers()
    
    Dim olkFolder As Outlook.Items, _
        olkContact As Outlook.ContactItem, _
           olkItems As Outlook.Items
    If Application.ActiveExplorer.CurrentFolder.DefaultItemType <> olContactItem Then
        MsgBox "You have to select a folder containing Contacts to run this macro.", vbCritical + vbOKOnly, "FixPhoneNumber Macro"
    Else
        NeedToSave = False
        Set olkFolder = Application.ActiveExplorer.CurrentFolder.Items
    '   On Error GoTo ErrorHandler
     '   Set olkItems = olkFolder.Restrict("[MobileTelephoneNumber] <= ''")
        Set olkItems = olkFolder.Restrict("[MessageClass]='IPM.Contact'")
        For x = olkItems.Count To 1 Step -1
            Set olkContact = olkItems.Item(x)
            olkContact.MobileTelephoneNumber = FixTelNumber(olkContact.MobileTelephoneNumber)
            If NeedToSave Then
                olkContact.Save
                NeedToSave = False
            End If
        Next
    '    Set olkItems = olkFolder.Restrict("[BusinessTelephoneNumber] <> ' '")
        For x = olkItems.Count To 1 Step -1
            Set olkContact = olkItems.Item(x)
            olkContact.BusinessTelephoneNumber = FixTelNumber(olkContact.BusinessTelephoneNumber)
            If NeedToSave Then
                olkContact.Save
                NeedToSave = False
            End If
        Next
   '     Set olkItems = olkFolder.Restrict("[Business2TelephoneNumber] <> ' '")
        For x = olkItems.Count To 1 Step -1
            Set olkContact = olkItems.Item(x)
            olkContact.Business2TelephoneNumber = FixTelNumber(olkContact.Business2TelephoneNumber)
            If NeedToSave Then
                olkContact.Save
                NeedToSave = False
            End If
        Next
  '      Set olkItems = olkFolder.Restrict("[BusinessFaxNumber] <> ' '")
        For x = olkItems.Count To 1 Step -1
            Set olkContact = olkItems.Item(x)
            olkContact.BusinessFaxNumber = FixTelNumber(olkContact.BusinessFaxNumber)
            If NeedToSave Then
                olkContact.Save
                NeedToSave = False
            End If
        Next
  '      Set olkItems = olkFolder.Restrict("[HomeTelephoneNumber] <> ''")
        For x = olkItems.Count To 1 Step -1
            Set olkContact = olkItems.Item(x)
            olkContact.HomeTelephoneNumber = FixTelNumber(olkContact.HomeTelephoneNumber)
            If NeedToSave Then
                olkContact.Save
                NeedToSave = False
            End If
        Next
  '      Set olkItems = olkFolder.Restrict("[AssistantTelephoneNumber] <> ''")
        For x = olkItems.Count To 1 Step -1
            Set olkContact = olkItems.Item(x)
            olkContact.AssistantTelephoneNumber = FixTelNumber(olkContact.AssistantTelephoneNumber)
            If NeedToSave Then
                olkContact.Save
                NeedToSave = False
            End If
        Next
   '     Set olkItems = olkFolder.Restrict("[OtherTelephoneNumber] <> ''")
        For x = olkItems.Count To 1 Step -1
            Set olkContact = olkItems.Item(x)
            olkContact.OtherTelephoneNumber = FixTelNumber(olkContact.OtherTelephoneNumber)
            If NeedToSave Then
                olkContact.Save
                NeedToSave = False
            End If
        Next
        MsgBox "All done!", vbInformation + vbOKOnly, "FixPhoneNumber Macro"
    End If
    Set olkContact = Nothing
    Set olkFolder = Nothing
    Set olkItems = Nothing
Exit Sub
ErrorHandler:
    On Error Resume Next
 
End Sub
 
Function FixTelNumber(TelNumber As String)
    NeedToSave = False
    If TelNumber = "" Or TelNumber = " " Then
        FixTelNumber = ""
        NeedToSave = False
        Exit Function
    End If
    If Left(TelNumber, 3) = "00 " Then
        TelNumber = "+" & Mid(TelNumber, 4)
        NeedToSave = True
    End If
    If Left(TelNumber, 2) = "00" Then
        TelNumber = "+" & Mid(TelNumber, 3)
        NeedToSave = True
    End If
    Select Case Left(TelNumber, 6)
        Case Is = "+44 (0"
            FixTelNumber = "+44 (" & Mid(TelNumber, 7)
            NeedToSave = True
            Exit Function
        Case Else
           ' do nothing
    End Select
    Select Case Left(TelNumber, 5)
        Case Is = "+44 0"
            If Mid(TelNumber, 6, 1) = "7" Then
                ' then ASSUME a current UK mobile number
                FixTelNumber = "+44 (" & Mid(TelNumber, 6, 4) & ")" & Mid(TelNumber, 10)
            Else
                If Mid(TelNumber, 6, 1) = "1" Or Mid(TelNumber, 6, 1) = "2" Then
                ' then ASSUME a current UK landline number
                    If Mid(TelNumber, 6, 3) = "207" Or Mid(TelNumber, 6, 3) = "208" Then
                        FixTelNumber = "+44 (" & Mid(TelNumber, 6, 3) & ")" & Mid(TelNumber, 9)
                    Else
                        FixTelNumber = "+44 (" & Trim(Mid(TelNumber, 6, 4)) & ")" & Mid(TelNumber, 10)
                    End If
                Else
                    If Mid(TelNumber, 6, 1) = " " Then
                        ' do nothing more/manual fix
                        Exit Function
                    Else
                    ' then ASSUME a really OLD UK mobile number, stuff in a 7!
                        FixTelNumber = "+44 (7" & Mid(TelNumber, 6, 3) & ")" & Mid(TelNumber, 9)
                    End If
                End If
            End If
            NeedToSave = True
        Case Else
           ' do nothing
    End Select
    Select Case Left(TelNumber, 2)
        Case Is = "00"
            FixTelNumber = "+" & Mid(TelNumber, 3)
            NeedToSave = True
      
        Case Else
           ' do nothing
    End Select
End Function

Open in new window

Sorry forgot to mention that you need to declare this public variable for it to work:

Public NeedToSave As Boolean


Sub FixCountries()
    Dim olkFolder As Outlook.Items, _
        olkContact As Outlook.ContactItem, _
            olkItems As Outlook.Items
    Dim CheckCountry As String
    If Application.ActiveExplorer.CurrentFolder.DefaultItemType <> olContactItem Then
        MsgBox "You have to select a folder containing Contacts to run this macro.", vbCritical + vbOKOnly, "FixCountries Macro"
    Else
        NeedToSave = False
       Set olkFolder = Application.ActiveExplorer.CurrentFolder.Items
   '     On Error GoTo ErrorHandler
  Set olkItems = olkFolder.Restrict("[MessageClass]='IPM.Contact'")
       For x = olkItems.Count To 1 Step -1
        Set olkContact = olkItems.Item(x)
        olkContact.BusinessAddressCountry = FixCountry(olkContact.BusinessAddressCountry, Trim(Left(olkContact.BusinessTelephoneNumber, 4)))
          If NeedToSave Then
             olkContact.Save
             NeedToSave = False
          End If
       Next
       MsgBox "All done!", vbInformation + vbOKOnly, "FixCountries Macro"
    End If
    Set olkContact = Nothing
    Set olkItems = Nothing
    Set olkFolder = Nothing
    Exit Sub
ErrorHandler:
    On Error Resume Next
    
End Sub
 
Function FixCountry(Country As String, Code As String)
    NeedToSave = False
    If Country <> "" And Country <> " " Then
        FixCountry = Country
        NeedToSave = False
        Exit Function
    End If
    If Code = "" Or Code = " " Then
        FixCountry = Country
        NeedToSave = False
        Exit Function
    End If
    Select Case Left(Code, 3)
        Case Is = "+44"
            FixCountry = "United Kingdom"
            NeedToSave = True
        Case Is = "+33"
            FixCountry = "France"
            NeedToSave = True
        Case Is = "+49"
            FixCountry = "Germany"
            NeedToSave = True
        Case Is = "+31"
            FixCountry = "Netherlands"
            NeedToSave = True
        Case Is = "+46"
            FixCountry = "Sweden"
            NeedToSave = True
        Case Is = "+41"
            FixCountry = "Switzerland"
            NeedToSave = True
        Case Is = "+39"
            FixCountry = "Italy"
            NeedToSave = True
    '    Case "+353"
     '       FixCountry = "Ireland"
      '      NeedToSave = True
        Case Is = "+34"
            FixCountry = "Spain"
            NeedToSave = True
        Case Is = "+1 "
            FixCountry = "United States of America"
            NeedToSave = True
        Case Else
           FixCountry = "United Kingdom"
           NeedToSave = True
    End Select
End Function

Open in new window

Thanks again BDF
Thanks, Martyn, and you're welcome.  Glad you got it sorted out.  Sorry we couldn't get Restrict to work properly.