Solved

VBA Mass Update of Contact Telepohone Numbers

Posted on 2008-10-24
14
542 Views
Last Modified: 2013-11-05
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

0
Comment
Question by:Bandolier
  • 8
  • 6
14 Comments
 
LVL 76

Expert Comment

by:David Lee
ID: 22803021
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] <= ' '")
0
 

Author Comment

by:Bandolier
ID: 22804188
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
0
 
LVL 76

Expert Comment

by:David Lee
ID: 22804484
"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.
0
 

Author Comment

by:Bandolier
ID: 22806986
Thanks for the tutorial DBF.  That helps a lot!
Any thoughts on "What does the <= ' ' actually mean"
Cheers
Bandolier
0
 
LVL 76

Expert Comment

by:David Lee
ID: 22807114
Less than or equal to nothing.
0
 

Author Comment

by:Bandolier
ID: 22807179
What's less than nothing?
0
 

Author Comment

by:Bandolier
ID: 22807295
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
0
How to improve team productivity

Quip adds documents, spreadsheets, and tasklists to your Slack experience
- Elevate ideas to Quip docs
- Share Quip docs in Slack
- Get notified of changes to your docs
- Available on iOS/Android/Desktop/Web
- Online/Offline

 
LVL 76

Expert Comment

by:David Lee
ID: 22807528
Is there a space between the two apostrophes?  If not, there should be.
0
 

Author Comment

by:Bandolier
ID: 22807549
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!
0
 
LVL 76

Accepted Solution

by:
David Lee earned 125 total points
ID: 22809627
I did some additional testing and clearly this approach doesn't work for all fields.  I can't explain why.  I agree with your comment about Foxpro.  Outlook isn't a database though.  

The best suggestion I can make is to loop through the items rather than using Restrict.  
0
 

Author Comment

by:Bandolier
ID: 22812298
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

0
 

Author Comment

by:Bandolier
ID: 22812378
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

0
 

Author Closing Comment

by:Bandolier
ID: 31509828
Thanks again BDF
0
 
LVL 76

Expert Comment

by:David Lee
ID: 22813684
Thanks, Martyn, and you're welcome.  Glad you got it sorted out.  Sorry we couldn't get Restrict to work properly.  
0

Featured Post

Free Trending Threat Insights Every Day

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

Join & Write a Comment

Not sure what the best email signature size is? Are you worried about email signature image size? Follow this best practice guide.
This process describes the steps required to Import and Export data from and to .pst files using Exchange 2010. We can use these steps to export data from a user to a .pst file, import data back to the same or a different user, or even import data t…
This Experts Exchange video Micro Tutorial shows how to tell Microsoft Office that a word is NOT spelled correctly. Microsoft Office has a built-in, main dictionary that is shared by Office apps, including Excel, Outlook, PowerPoint, and Word. When …
To add imagery to an HTML email signature, you have two options available to you. You can either add a logo/image by embedding it directly into the signature or hosting it externally and linking to it. The vast majority of email clients display l…

758 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

19 Experts available now in Live!

Get 1:1 Help Now