none
Outlook 2007 Macro For Phone Number Fields of Contacts RRS feed

  • Question

  • I have the following macro that if I have a phone number in the note field of 7136669999, when I run the macro it fixes the phone number to: 713.666.9999 But this macro does not do it when the phone number is in the business phone number field, the home phone number field or the cell phone number field. So what can we add to this for each phone number fields please, as this helps me very quickly in terms of my contacts.

    Thanks very much!

    Public Sub PhoneNumberFix()

    Dim Ins As outlook.inspector
    Dim Document As Word.Document
    Dim Word As Word.Application
    Dim Selection As Word.Selection

    Set Ins = Application.ActiveInspector
    Set Document = Ins.WordEditor
    Set Word = Document.Application
    Set Selection = Word.Selection

    Selection.HomeKey Unit:=wdLine
    Selection.MoveRight Unit:=wdCharacter, Count:=3
    Selection.TypeText Text:="."
    Selection.MoveRight Unit:=wdCharacter, Count:=3
    Selection.TypeText Text:="."

    End Sub

    Sunday, August 2, 2015 7:59 PM

Answers

  • Hello Imseaz,

    You need to use corresponding properties of the ContactItem class, not the Outlook item body represented by the Word editor. Take a look at the following properties:

    HomeTelephoneNumber

    OtherTelephoneNumber

    BusinessTelephoneNumber

    CallbackTelephoneNumber

    CarTelephoneNumber

    Sunday, August 2, 2015 8:38 PM
  • According to your description, I have make a sample, so you can refer to below code:

    >>> 7136669999, when I run the macro it fixes the phone number to: 713.666.9999

    You need modify sample code base on your requirement.

    Public Sub ChangeContact()
    
        On Error GoTo On_Error
    
        Dim contactItem  As Outlook.contactItem
        ' Get ContactItem By FullName
        Set contactItem = getContact("Test")
    
        ' contactItem.FullName = "Greg Thatcher"
    
        contactItem.Email1Address = "gregt@xobni.com"
    
        contactItem.BusinessTelephoneNumber = FixFormat(contactItem.BusinessTelephoneNumber)
    
        contactItem.HomeTelephoneNumber = "415 555 1234"
    
        contactItem.MobileTelephoneNumber = "415 555 1236"
    
        ' contactItem.AddPicture ("C:\Users\Public\Pictures\Sample Pictures\jellyfish.jpg")
    
        contactItem.Display
    
    Exiting:
    
            Exit Sub
    
    On_Error:
    
        MsgBox "error=" & Err.Number & " " & Err.Description
    
        Resume Exiting
    
    End Sub
    
    Function getContact(contactName As String) As Outlook.contactItem
    
    Dim olnameSpace As Outlook.NameSpace
    
    Dim contactFolder As Outlook.MAPIFolder
    
    Dim contacts As Outlook.Items
    
    Set olnameSpace = Application.GetNamespace("MAPI")
    
    Set contactFolder = olnameSpace.GetDefaultFolder(olFolderContacts)
    
    Set contacts = contactFolder.Items
    
    Set getContact = contacts.Item(contactName)
    
    End Function
    
    Private Function FixFormat(strPhone As String) As String
    
     strPhone = Trim(strPhone)
    
     FixFormat = strPhone
    
     If strPhone = "" Then Exit Function
    
     Dim prefix As String
    
     prefix = Left(strPhone, 1)
    
     ' Configured for US
    
     ' Enter the correct prefix here
    
     Do While (prefix = "+" Or prefix = "1")
    
     ' if the prefix is 2 digits, change to 4;
    
     ' if 3 digits, change to 5
    
     strPhone = Mid(strPhone, 3)
    
     prefix = Left(strPhone, 1)
    
     Loop
    
    ' After we clean up the country code, we remove non-numeric characters
    
    ' Can be tweaked to change formatting, ie: change 202.555.1212 to 202-555-1212
    
     strPhone = Replace(strPhone, "(", "[")
    
     strPhone = Replace(strPhone, ")", "]")
    
     strPhone = Replace(strPhone, ".", "")
    
     strPhone = Replace(strPhone, " ", "")
    
     strPhone = Replace(strPhone, "-", "")
    
     FixFormat = strPhone
    
    End Function
    

    Tuesday, August 4, 2015 9:42 AM

All replies

  • Hello Imseaz,

    You need to use corresponding properties of the ContactItem class, not the Outlook item body represented by the Word editor. Take a look at the following properties:

    HomeTelephoneNumber

    OtherTelephoneNumber

    BusinessTelephoneNumber

    CallbackTelephoneNumber

    CarTelephoneNumber

    Sunday, August 2, 2015 8:38 PM
  • Thanks for your reply.  I am not a technical person...can you please show me what to change re the code.

    Thanks very much.

    Sunday, August 2, 2015 8:51 PM
  • You need to use properties I mentioned in my previous reply. 

    I am not a technical person...

    The forum is for developers, not just requesting the ready-made code. So, I'd suggest starting from the Getting Started with VBA in Outlook 2010 article in MSDN. 

    Sunday, August 2, 2015 9:36 PM
  • I figured out that when I copy the numbers that need to be fixed and then go to the business phone field, the following code copies the numbers directly to the note field, fixes it, copies it, deletes it from the note field an paste to the business phone field. So also, is there a code that pastes to the note field?

    Public Sub BusinessPhoneNumberFixPaste()

    Dim Ins As outlook.inspector
    Dim Document As Word.Document
    Dim Word As Word.Application
    Dim Selection As Word.Selection

    Set Ins = Application.ActiveInspector
    Set Document = Ins.WordEditor
    Set Word = Document.Application
    Set Selection = Word.Selection


    Selection.PasteAndFormat (wdPasteDefault)
    Selection.MoveUp Unit:=wdLine, Count:=1
    Selection.HomeKey Unit:=wdLine
    Selection.MoveRight Unit:=wdCharacter, Count:=3
    Selection.TypeText Text:="."
    Selection.MoveRight Unit:=wdCharacter, Count:=3
    Selection.TypeText Text:="."
    Selection.HomeKey Unit:=wdLine
    Selection.MoveRight Unit:=wdCharacter, Count:=12, Extend:=wdExtend
    Selection.Copy
    Selection.Delete Unit:=wdCharacter, Count:=1

    Call PastetoBusinessPhone

    End Sub
    Monday, August 3, 2015 3:16 PM
  • According to your description, I have make a sample, so you can refer to below code:

    >>> 7136669999, when I run the macro it fixes the phone number to: 713.666.9999

    You need modify sample code base on your requirement.

    Public Sub ChangeContact()
    
        On Error GoTo On_Error
    
        Dim contactItem  As Outlook.contactItem
        ' Get ContactItem By FullName
        Set contactItem = getContact("Test")
    
        ' contactItem.FullName = "Greg Thatcher"
    
        contactItem.Email1Address = "gregt@xobni.com"
    
        contactItem.BusinessTelephoneNumber = FixFormat(contactItem.BusinessTelephoneNumber)
    
        contactItem.HomeTelephoneNumber = "415 555 1234"
    
        contactItem.MobileTelephoneNumber = "415 555 1236"
    
        ' contactItem.AddPicture ("C:\Users\Public\Pictures\Sample Pictures\jellyfish.jpg")
    
        contactItem.Display
    
    Exiting:
    
            Exit Sub
    
    On_Error:
    
        MsgBox "error=" & Err.Number & " " & Err.Description
    
        Resume Exiting
    
    End Sub
    
    Function getContact(contactName As String) As Outlook.contactItem
    
    Dim olnameSpace As Outlook.NameSpace
    
    Dim contactFolder As Outlook.MAPIFolder
    
    Dim contacts As Outlook.Items
    
    Set olnameSpace = Application.GetNamespace("MAPI")
    
    Set contactFolder = olnameSpace.GetDefaultFolder(olFolderContacts)
    
    Set contacts = contactFolder.Items
    
    Set getContact = contacts.Item(contactName)
    
    End Function
    
    Private Function FixFormat(strPhone As String) As String
    
     strPhone = Trim(strPhone)
    
     FixFormat = strPhone
    
     If strPhone = "" Then Exit Function
    
     Dim prefix As String
    
     prefix = Left(strPhone, 1)
    
     ' Configured for US
    
     ' Enter the correct prefix here
    
     Do While (prefix = "+" Or prefix = "1")
    
     ' if the prefix is 2 digits, change to 4;
    
     ' if 3 digits, change to 5
    
     strPhone = Mid(strPhone, 3)
    
     prefix = Left(strPhone, 1)
    
     Loop
    
    ' After we clean up the country code, we remove non-numeric characters
    
    ' Can be tweaked to change formatting, ie: change 202.555.1212 to 202-555-1212
    
     strPhone = Replace(strPhone, "(", "[")
    
     strPhone = Replace(strPhone, ")", "]")
    
     strPhone = Replace(strPhone, ".", "")
    
     strPhone = Replace(strPhone, " ", "")
    
     strPhone = Replace(strPhone, "-", "")
    
     FixFormat = strPhone
    
    End Function
    

    Tuesday, August 4, 2015 9:42 AM
  • thanks very much...this looks like you have to put the phone number in the code....correct?
    Tuesday, August 4, 2015 5:49 PM
  • >>>...this looks like you have to put the phone number in the code....correct?
    You have not to put the phone number in the code.

    "contactItem.BusinessTelephoneNumber = FixFormat(contactItem.BusinessTelephoneNumber)"

    This line code gets BusinessTelephoneNumber from ContactItem which has created with "Test" fullname. You can get the Phone number from other item, for example MailItem.

    Wednesday, August 5, 2015 7:45 AM