Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people, just like you, are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
Solved

VBA Mass Update of Contact Telepohone Numbers

Posted on 2008-10-24
14
546 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
Free learning courses: Active Directory Deep Dive

Get a firm grasp on your IT environment when you learn Active Directory best practices with Veeam! Watch all, or choose any amount, of this three-part webinar series to improve your skills. From the basics to virtualization and backup, we got you covered.

 

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 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 learning courses: Active Directory Deep Dive

Get a firm grasp on your IT environment when you learn Active Directory best practices with Veeam! Watch all, or choose any amount, of this three-part webinar series to improve your skills. From the basics to virtualization and backup, we got you covered.

Question has a verified solution.

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

Large Outlook files lead to various unwanted errors and corruption issues. Furthermore, large outlook files can also make Outlook take longer to start-up, search, navigate, and shut-down. So, In this article, i will discuss a method to make your Out…
Many people use more than one email account and so it becomes difficult for them to manage them when they use separate accounts,  so, in this article, I have shared an easy way to add Other Mail Accounts in your Google Inbox. It helps to combine all…
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
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…

837 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