Kể từ ngày 5-10 hơn 10 triệu số điện thoại cố định đã thay đổi (thêm số 3 vào đầu), và từ ngày 19-10 sẽ không còn hệ thống số điện thoại cũ nữa.
Đối với những người có danh bạ Address book lớn cỡ vài trăm đến vài ngàn trong điện thoại di động và trên máy tính để thay đổi bằng tay từng số 1 thì quả là cực hình. Outlook thì lại không có chức năng Replace, mà nếu có nó cũng không có chức năng chỉ thay thế đầu dòng).
Sau đây là đoạn mã trong outlook (2003,2007) có thể giúp chúng ta thay đổi hàng loạt.

Một số lưu ý:
- Trước khi thực hiện nên backup dữ liệu và đồng bộ điện thoại di động với outlook (sync)
- Trước khi chạy đoạn mã này nên backup toàn bộ dữ liệu bằng cách copy thư mục dữ liệu pst của outlook ra chỗ khác, hoặc export ra excel hoặc access (hạn chế dùng excel vì 1 số trường hợp excel sẽ tự động làm biến đổi số điện thoại nhất là các dạng: 04-654321: excel sẽ làm pháp tính trừ, thế là hỏng hết.
- Đoạn code dưới đây sẽ tìm duyệt cả các trường điện thoại, fax, mobile phone để tìm kiếm tất cả các số cố định và thay thế.
- Với mỗi đầu số (04, 0288).. chỉ được làm 1 lần, nếu làm tiếp nó lại thay thế tiếp và như vậy là sai.

Cách thực hiện:
- Mở outlook, nhấn phím Alt-F11
- Tùy theo phiiên bảo nào của outlook có thể kích hoạt dòng khai bào folder tương ứng xem đoạn code.
- Copy paste đoạn mã dưới đây
- Thay mã vùng tương ứng (ví dụ "04" ->"043"...)
- Click chuột vào phần body của PhoneNumberAddressBookFindReplace()
- Nhấn phím F8
- Nhấn phím F5
- Xong

còn đây là code:

Trích:

__________________
--
Mobi: 0982092411
Yms: Atuk91

-----------Reply---------
bác cho đoạn code vào trong wrap quote cho nó dễ nhìn bác ơi

-----------Reply---------
Đúng thế, cách này tuyệt vời. Tuyệt nhất với những ai lưu thật nhiều số máy bàn. Cá nhân Em thì trong danh bạ có gần 500 số, có tới 590 số là Di Động.

-----------Reply---------
Phiên bản 2 đổi mã điện thoại cho tất cả các nhà cung cấp dịch vụ (5), mới chỉ riêng cho Hà Nội và Tp HCM. Các bạn đã chạy version 1.0 rồi chạy tiếp bản này không có vấn đề gì, vì đã có đoạn fix ở cuối.

PS. Xóa bản cũ đi thay bằng đoạn code này. Bản này chạy cho cả 2 phiên bản outlook 2003 và 2007.
4 nhà cũng cấp dịch vụ còn lại đến ngày 26-10 mới đổi các bạn nhé.

PHP Code:



PublicSubPhoneNumberAddressBookFindReplace()
"PhoneNumberAddressBookFindReplace()ReleasedunderGPL,version2.0
"(c)DangMinhTuan@VietkeyGroup
"Email:tuanvietkey@gmail.com
"Hanoi,7-10-2008.
"
"Thaydoimasodienthoai
"ChoHanoivaTpHCM
"
"VNPTHanoi

ReFileContacts"045","0435"
ReFileContacts"046","0436"
ReFileContacts"047","0437"
ReFileContacts"048","0438"
ReFileContacts"049","0439"

"ViettelHanoi
ReFileContacts"0425","04625"
ReFileContacts"0426","04626"
ReFileContacts"0427","04627"
ReFileContacts"0428","04628"
ReFileContacts"0429","04629"

"EVNHanoi
ReFileContacts"0420","04220"
ReFileContacts"0421","04221"
ReFileContacts"0422","04222"
ReFileContacts"0423","04223"
ReFileContacts"0424","04224"

ReFileContacts"0446","04246"
ReFileContacts"0447","04247"
ReFileContacts"0448","04248"
ReFileContacts"0449","04249"

"VTCHanoi
ReFileContacts"0445","04445"

"VNPTTpHCM
ReFileContacts"085","0835"
ReFileContacts"086","0836"
ReFileContacts"087","0837"
ReFileContacts"088","0838"
ReFileContacts"089","0839"

"ViettelTpHCM
ReFileContacts"0825","08625"
ReFileContacts"0826","08626"
ReFileContacts"0827","08627"
ReFileContacts"0828","08628"
ReFileContacts"0829","08629"

"EVNTpHCM
ReFileContacts"0820","08220"
ReFileContacts"0821","08221"
ReFileContacts"0822","08222"
ReFileContacts"0823","08223"
ReFileContacts"0824","08224"

ReFileContacts"0846","08246"
ReFileContacts"0847","08247"
ReFileContacts"0848","08248"
ReFileContacts"0849","08249"

"VTCTpHCM
ReFileContacts"0845","08445"

"SPTTpHCM
ReFileContacts"0840","08540"
ReFileContacts"0841","08541"
ReFileContacts"0842","08542"
ReFileContacts"0843","08543"
ReFileContacts"0844","08544"

"FixVNPT

"ViettelHanoi
ReFileContacts"04325","04625"
ReFileContacts"04326","04626"
ReFileContacts"04327","04627"
ReFileContacts"04328","04628"
ReFileContacts"04329","04629"

"EVNHanoi
ReFileContacts"04320","04220"
ReFileContacts"04321","04221"
ReFileContacts"04322","04222"
ReFileContacts"04323","04223"
ReFileContacts"04324","04224"

ReFileContacts"04346","04246"
ReFileContacts"04347","04247"
ReFileContacts"04348","04248"
ReFileContacts"04349","04249"

"VTCHanoi
ReFileContacts"04345","04445"

"ViettelTpHCM
ReFileContacts"08325","08625"
ReFileContacts"08326","08626"
ReFileContacts"08327","08627"
ReFileContacts"08328","08628"
ReFileContacts"08329","08629"

"EVNTpHCM
ReFileContacts"08320","08220"
ReFileContacts"08321","08221"
ReFileContacts"08322","08222"
ReFileContacts"08323","08223"
ReFileContacts"08324","08224"

ReFileContacts"08346","08246"
ReFileContacts"08347","08247"
ReFileContacts"08348","08248"
ReFileContacts"08349","08249"

"VTCTpHCM
ReFileContacts"08345","08445"

MsgBox"Daxong!"

EndSub

PublicSubReFileContacts(findTextAsString,replaceTextAsString)
DimitemsAsitems,itemAsContactItem,folderAsOutlook.MAPIFolder"folder
DimcontactItemsAsOutlook.items
DimitemContactAsOutlook.ContactItem
DimcountAsInteger

Setfolder=Session.GetDefaultFolder(olFolderContacts)
Setitems=folder.items
count=items.count
Ifcount=0Then
MsgBox"Khongcodiachinao!"
ExitSub
EndIf

SetcontactItems=items.Restrict("[MessageClass]="IPM.Contact")

DimnAsInteger
n=0
ForEachitemContactIncontactItems

IfInStrB(1,itemContact.BusinessTelephoneNumber,findText,vbBinaryCompare)=1Then
itemContact.BusinessTelephoneNumber=VBA.Replace(itemContact.BusinessTelephoneNumber,findText,replaceText,1,1,vbBinaryCompare)
n=n+1
EndIf

IfInStrB(1,itemContact.AssistantTelephoneNumber,findText,vbBinaryCompare)=1Then
itemContact.AssistantTelephoneNumber=VBA.Replace(itemContact.AssistantTelephoneNumber,findText,replaceText,1,1,vbBinaryCompare)
n=n+1
EndIf

IfInStrB(1,itemContact.Business2TelephoneNumber,findText,vbBinaryCompare)=1Then
itemContact.Business2TelephoneNumber=VBA.Replace(itemContact.Business2TelephoneNumber,findText,replaceText,1,1,vbBinaryCompare)
n=n+1
EndIf

IfInStrB(1,itemContact.BusinessFaxNumber,findText,vbBinaryCompare)=1Then
itemContact.BusinessFaxNumber=VBA.Replace(itemContact.BusinessFaxNumber,findText,replaceText,1,1,vbBinaryCompare)
n=n+1
EndIf

IfInStrB(1,itemContact.CallbackTelephoneNumber,findText,vbBinaryCompare)=1Then
itemContact.CallbackTelephoneNumber=VBA.Replace(itemContact.CallbackTelephoneNumber,findText,replaceText,1,1,vbBinaryCompare)
n=n+1
EndIf

IfInStrB(1,itemContact.CarTelephoneNumber,findText,vbBinaryCompare)=1Then
itemContact.CarTelephoneNumber=VBA.Replace(itemContact.CarTelephoneNumber,findText,replaceText,1,1,vbBinaryCompare)
n=n+1
EndIf

IfInStrB(1,itemContact.CompanyMainTelephoneNumber,findText,vbBinaryCompare)=1Then
itemContact.CompanyMainTelephoneNumber=VBA.Replace(itemContact.CompanyMainTelephoneNumber,findText,replaceText,1,1,vbBinaryCompare)
n=n+1
EndIf

IfInStrB(1,itemContact.Home2TelephoneNumber,findText,vbBinaryCompare)=1Then
itemContact.Home2TelephoneNumber=VBA.Replace(itemContact.Home2TelephoneNumber,findText,replaceText,1,1,vbBinaryCompare)
n=n+1
EndIf

IfInStrB(1,itemContact.HomeFaxNumber,findText,vbBinaryCompare)=1Then
itemContact.HomeFaxNumber=VBA.Replace(itemContact.HomeFaxNumber,findText,replaceText,1,1,vbBinaryCompare)
n=n+1
EndIf

IfInStrB(1,itemContact.HomeTelephoneNumber,findText,vbBinaryCompare)=1Then
itemContact.HomeTelephoneNumber=VBA.Replace(itemContact.HomeTelephoneNumber,findText,replaceText,1,1,vbBinaryCompare)
n=n+1
EndIf

IfInStrB(1,itemContact.MobileTelephoneNumber,findText,vbBinaryCompare)=1Then
itemContact.MobileTelephoneNumber=VBA.Replace(itemContact.MobileTelephoneNumber,findText,replaceText,1,1,vbBinaryCompare)
n=n+1
EndIf

IfInStrB(1,itemContact.OtherFaxNumber,findText,vbBinaryCompare)=1Then
itemContact.OtherFaxNumber=VBA.Replace(itemContact.OtherFaxNumber,findText,replaceText,1,1,vbBinaryCompare)
n=n+1
EndIf

IfInStrB(1,itemContact.OtherTelephoneNumber,findText,vbBinaryCompare)=1Then
itemContact.OtherTelephoneNumber=VBA.Replace(itemContact.OtherTelephoneNumber,findText,replaceText,1,1,vbBinaryCompare)
n=n+1
EndIf

IfInStrB(1,itemContact.PrimaryTelephoneNumber,findText,vbBinaryCompare)=1Then
itemContact.PrimaryTelephoneNumber=VBA.Replace(itemContact.PrimaryTelephoneNumber,findText,replaceText,1,1,vbBinaryCompare)
n=n+1
EndIf

IfInStrB(1,itemContact.RadioTelephoneNumber,findText,vbBinaryCompare)=1Then
itemContact.RadioTelephoneNumber=VBA.Replace(itemContact.RadioTelephoneNumber,findText,replaceText,1,1,vbBinaryCompare)
n=n+1
EndIf
itemContact.Save

Next
MsgBoxn,vbOKOnly,findText
EndSub

(c) Dang Minh Tuan @ Vietkey Group
Nguồn: tathy.com/thanglong

-----------Reply---------
-----------Reply---------