VBA Macro for formatting multiple phone numbers in outlook contacts

Status
Not open for further replies.
P

Patrick F

Thanks to Michal Bednarz (http://www.codetwo.com), I was able to format all my contacts phone numbers the way I like. I know, perhaps not groundbreaking, lol, but there were enough people trying to do this in my search for the answer that I thought I'd throw this up to make someone else have it easier. My modifications and additions format phone numbers to: xxx-xxx-xxx, but the code can easily be tweaked to give you what you want.

One note, Outlook likes to auto-format phone numbers but I found several tips pointing to modifying the phone options in control panel - changing the area code to 99999, makes outlook stop putting the brackets around the area codes.

heres the code:

Sub FormatPhoneNumber()

Dim oFolder As MAPIFolder

Set oFolder = Application.ActiveExplorer.CurrentFolder

If Left(UCase(oFolder.DefaultMessageClass), 11) <> " IPM.CONTACT" Then

MsgBox " Select contact folder" , vbExclamation

Exit Sub

End If

Dim nCounter As Integer

nCounter = 0

Dim oItem

For Each oItem In oFolder.Items

Dim oContact As ContactItem

Set oContact = oItem

If Not oContact Is Nothing Then

With oContact

.AssistantTelephoneNumber = RemovePrefix(.AssistantTelephoneNumber)

.Business2TelephoneNumber = RemovePrefix(.Business2TelephoneNumber)

.BusinessFaxNumber = RemovePrefix(.BusinessFaxNumber)

.BusinessTelephoneNumber = RemovePrefix(.BusinessTelephoneNumber)

.CallbackTelephoneNumber = RemovePrefix(.CallbackTelephoneNumber)

.CarTelephoneNumber = RemovePrefix(.CarTelephoneNumber)

.CompanyMainTelephoneNumber = RemovePrefix(.CompanyMainTelephoneNumber)

.Home2TelephoneNumber = RemovePrefix(.Home2TelephoneNumber)

.HomeFaxNumber = RemovePrefix(.HomeFaxNumber)

.HomeTelephoneNumber = RemovePrefix(.HomeTelephoneNumber)

.ISDNNumber = RemovePrefix(.ISDNNumber)

.MobileTelephoneNumber = RemovePrefix(.MobileTelephoneNumber)

.OtherFaxNumber = RemovePrefix(.OtherFaxNumber)

.OtherTelephoneNumber = RemovePrefix(.OtherTelephoneNumber)

.PagerNumber = RemovePrefix(.PagerNumber)

.PrimaryTelephoneNumber = RemovePrefix(.PrimaryTelephoneNumber)

.RadioTelephoneNumber = RemovePrefix(.RadioTelephoneNumber)

.TelexNumber = RemovePrefix(.TelexNumber)

.TTYTDDTelephoneNumber = RemovePrefix(.TTYTDDTelephoneNumber)



.AssistantTelephoneNumber = RemoveChars(.AssistantTelephoneNumber)

.Business2TelephoneNumber = RemoveChars(.Business2TelephoneNumber)

.BusinessFaxNumber = RemoveChars(.BusinessFaxNumber)

.BusinessTelephoneNumber = RemoveChars(.BusinessTelephoneNumber)

.CallbackTelephoneNumber = RemoveChars(.CallbackTelephoneNumber)

.CarTelephoneNumber = RemoveChars(.CarTelephoneNumber)

.CompanyMainTelephoneNumber = RemoveChars(.CompanyMainTelephoneNumber)

.Home2TelephoneNumber = RemoveChars(.Home2TelephoneNumber)

.HomeFaxNumber = RemoveChars(.HomeFaxNumber)

.HomeTelephoneNumber = RemoveChars(.HomeTelephoneNumber)

.ISDNNumber = RemoveChars(.ISDNNumber)

.MobileTelephoneNumber = RemoveChars(.MobileTelephoneNumber)

.OtherFaxNumber = RemoveChars(.OtherFaxNumber)

.OtherTelephoneNumber = RemoveChars(.OtherTelephoneNumber)

.PagerNumber = RemoveChars(.PagerNumber)

.PrimaryTelephoneNumber = RemoveChars(.PrimaryTelephoneNumber)

.RadioTelephoneNumber = RemoveChars(.RadioTelephoneNumber)

.TelexNumber = RemoveChars(.TelexNumber)

.TTYTDDTelephoneNumber = RemoveChars(.TTYTDDTelephoneNumber)

.Save



nCounter = nCounter + 1

End With

End If

Next

MsgBox nCounter & " contacts processed." , vbInformation

End Sub

Private Function RemovePrefix(strPhone As String) As String

strPhone = Trim(strPhone)

RemovePrefix = strPhone

If strPhone = " " Then Exit Function

Dim prefix As String

prefix = Left(strPhone, 1)

Do While (prefix = " +" Or prefix = " 1" )

strPhone = Mid(strPhone, 2)

prefix = Left(strPhone, 1)

Loop

RemovePrefix = strPhone

End Function

Private Function RemoveChars(strPhone As String) As String

strPhone = Trim(strPhone)

RemoveChars = strPhone

If strPhone = " " Then Exit Function

strPhone = Replace(strPhone, " (" , " " )

strPhone = Replace(strPhone, " )" , " " )

strPhone = Replace(strPhone, " ." , " -" )

strPhone = Replace(strPhone, " " , " -" )

RemoveChars = strPhone

End Function

cheers,

Patrick Freeman

> ..will work for cheap to get my foot in the door...

Someone Hire Me!
 
S

Sudharsan V

Glad to know that your issue is resolved. Thank you for sharing the resolution in the forum which would help community users facing the same issue.
 
Status
Not open for further replies.
Similar threads
Thread starter Title Forum Replies Date
L Macro/VBA to Reply All, with the original attachments Outlook VBA and Custom Forms 2
A VBA macro for 15 second loop in send and received just for 1 specific mailbox Outlook VBA and Custom Forms 1
G VBA Macro Calendar Printing Assistant 4
R Help Revising VBA macro to delete email over different time span Outlook VBA and Custom Forms 0
L Moving emails with similar subject and find the timings between the emails using outlook VBA macro Outlook VBA and Custom Forms 1
N How can I increase/faster outlook VBA Macro Speed ? Using Outlook 2
D.Moore Folder view settings by VBA macro Outlook VBA and Custom Forms 57
J Help Please!!! Outlook 2016 - VBA Macro for replying with attachment in meeting invite Outlook VBA and Custom Forms 9
R VBA macro - new message Outlook VBA and Custom Forms 3
S Example VBA Macro - To Conditionally Change the From Account and Add a BCC Address on Emails Outlook VBA and Custom Forms 11
S VBA Macro - Run-time error '424': object required - Help Please Outlook VBA and Custom Forms 3
B VBA Macro for assigning multiple Categories to an email in my Inbox Outlook VBA and Custom Forms 1
M Slow VBA macro in Outlook Outlook VBA and Custom Forms 5
M VBA macro for Inbox's attachments search Outlook VBA and Custom Forms 0
Y VBA Macro to highlight some Keyword in mail body? Outlook VBA and Custom Forms 3
J Macro only runs within VBA Editor Outlook VBA and Custom Forms 2
D VBA macro printing attachments in shared mailbox Outlook VBA and Custom Forms 1
G VBA/Macro to remove page colour when replying or forwarding email Outlook VBA and Custom Forms 2
S Outlook 7 VBA macro for multiple filing Outlook VBA and Custom Forms 1
M Outlook VBA Macro that could retrieve/display the (From, Subject, Date Received) Outlook VBA and Custom Forms 2
Philip Rose Recreating a WORD Editing Macro to use in Outlook VBA Outlook VBA and Custom Forms 4
T Random problem in VBA macro Outlook VBA and Custom Forms 6
M recover deleted items vba macro Outlook VBA and Custom Forms 2
P Vba script including macro appears in rules but wont run Outlook VBA and Custom Forms 6
S VBA Macro to VBScript Outlook VBA and Custom Forms 1
L VBA Macro to flag sent emails Using Outlook 1
B Outlook vba macro Using Outlook 1
B Auto BCC VBA macro: how to add exceptions? Using Outlook 28
R VBA Macro to VBScript in a form- Help Please! Using Outlook 10
D VBA Macro Works in 2007 but errors in 2010 Using Outlook 2
C Outlook VBA - Create Macro Move Contact field Item to Another Using Outlook 1
E Word macro running from OL VBA throwing error on Word SaveAs?? Outlook VBA and Custom Forms 8
J Outlook custom form - VBS call VBA macro Outlook VBA and Custom Forms 3
N VBA Procedure (or Macro) to Stop Outlook from Closing? Outlook VBA and Custom Forms 2
M Run external program from Outlook VBA macro Outlook VBA and Custom Forms 5
D New Macro / VBA Outlook VBA and Custom Forms 7
J Specify Font Name or Face using VBA Macro in Word Outlook VBA and Custom Forms 2
S Custom VBA forms in Outlook--how to call w/macro? Outlook VBA and Custom Forms 1
S macro ist just worling wenn vba editor is open! Outlook VBA and Custom Forms 1
V Modifying the built in forms with VBA Outlook VBA and Custom Forms 4
S Excel VBA and shared calendar issue Outlook VBA and Custom Forms 4
L VBA unknown character Outlook VBA and Custom Forms 2
G Move tasks up/down todo list by VBA Outlook VBA and Custom Forms 1
diver864 vba for a rule to automatically accept meeting requests with 'vacation' in subject, change to all-day event, change to free, don't send reply Outlook VBA and Custom Forms 1
K Use VBA to find Sender and Recipient from Microsfot 365 Journaled Email Items Outlook VBA and Custom Forms 3
J Want to learn VBA Macros for Outlook. What book can you recommend? Outlook VBA and Custom Forms 2
F VBA code to dock Styles whenever I write or edit an email Outlook VBA and Custom Forms 0
C VBA to prompt for Sent folder destination Outlook VBA and Custom Forms 3
B Adding signature to bottom of VBA reply email Outlook VBA and Custom Forms 1
B Change Font and Font size using VBA Outlook VBA and Custom Forms 9

Similar threads

Top