Go Premium for a chance to win a PS4. Enter to Win

x
?
Solved

VBA Mass Update of Contact Telepohone Numbers

Posted on 2008-10-24
14
Medium Priority
?
561 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
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 

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

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

In this article I discuss my selections of the Top Four free Outlook OST File Viewers available. Open, view and read even damaged OST files by using these tools. They all provide a clear preview of all data such as emails, notes, tasks, calendars, e…
There can be many situations demanding the conversion of Outlook OST files to PST format and as such, there is no shortage of automated tools to perform this conversion. However, what makes Stellar OST to PST converter stand above the rest? Let us e…
Many of my clients call in with monstrous Gmail overloading issues with Outlook. A quick tip is to turn off the All Mail and Important folders from synching. Here is a quick video I made to show you how to turn off these and other folders in Gmail s…
A short tutorial showing how to set up an email signature in Outlook on the Web (previously known as OWA). For free email signatures designs, visit https://www.mail-signatures.com/articles/signature-templates/?sts=6651 If you want to manage em…

885 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