Đổi số điện thoại cố định hàng loạt trong mobile fone

Thảo luận trong 'Tin học với aqua' bắt đầu bởi Hecxogen, 9/10/08.

  1. Hecxogen

    Hecxogen Moderator

    Tham gia:
    3/9/06
    Bài viết:
    564
    Thích đã nhận:
    392
    Đến từ:
    hanoi
    Tình cơ sưu tầm được cái này để đổi hàng loạt số điện thoại trong mobile phone từ 04 sang 043 ( cả 08 sang 083 và v.v.. ). Chỉ dùng đối với ĐT có sync với MS Outlook 2003,2007 nhé
    Cách làm như sau

    - Mở Outlook, nhấn phím Alt-F11
    - Bấm chuột vào Project và bấm phím phải chuột vào "ThisOutlookSession" và chọn Viewcode
    - Copy đoạn mã dưới đây vào cửa sổ trên
    - Thay mã vùng tương ứng (ví d? "04" ->"043"...) ở dòng
    ReFileContacts "04", "043"
    ( Tương tự cho mã 08 và mã khác )

    - Click chuột vào Public Sub PhoneNumberAddressBookFindReplace()
    Ngay dòng đầu tiên
    - Nhấn phím F8
    - Nhấn phím F5
    - Xong

    Nếu báo lỗi về folder thì copy đoạn sau: folder As Outlook.MAPIFolder
    vào dòng sau và thay cho chỗ bôi đậm.
    Dim items As items, item As ContactItem, folder As folder


    Đã thử trên O2 Neo và rất OK

    Lưu ý:
    - Trước khi làm nên Sync ĐT với máy tính lại
    - Copy file Outlook.pst ra một chỗ khác để đề phòng sự cố ( lại copy lại )
    - Sau khi đổi trong Outlook xong sync lại.

    Đoạn code
    Public Sub PhoneNumberAddressBookFindReplace()
    ' PhoneNumberAddressBookFindReplace() Released under GPL, version 1.0
    ' Thay doi ma so dien thoai
    ' them so 3 vao dau
    ' vi du them dau so 3 cho cac so co dinh o Hanoi:
    ' ReFileContacts "04", "043"
    '
    '' vi du them dau so 3 cho cac so co dinh o tp HCM:
    ' ReFileContacts "08", "083"
    '
    ReFileContacts "04", "043"
    End Sub

    Public Sub ReFileContacts(findText As String, replaceText As String)
    Dim items As items, item As ContactItem, folder As folder
    Dim contactItems As Outlook.items
    Dim itemContact As Outlook.ContactItem
    Dim count As Integer

    Set folder = Session.GetDefaultFolder(olFolderContacts)
    Set items = folder.items
    count = items.count
    If count = 0 Then
    MsgBox "Khong co dia chi nao!"
    Exit Sub
    End If

    Set contactItems = items.Restrict("[MessageClass]='IPM.Contact'")

    Dim n As Integer
    n = 0
    For Each itemContact In contactItems

    If InStrB(1, itemContact.BusinessTelephoneNumber, findText, vbBinaryCompare) = 1 Then
    itemContact.BusinessTelephoneNumber = VBA.Replace(itemContact.BusinessTelephoneNumber, findText, replaceText, 1, 1, vbBinaryCompare)
    End If

    If InStrB(1, itemContact.AssistantTelephoneNumber, findText, vbBinaryCompare) = 1 Then
    itemContact.AssistantTelephoneNumber = VBA.Replace(itemContact.AssistantTelephoneNumber, findText, replaceText, 1, 1, vbBinaryCompare)
    End If

    If InStrB(1, itemContact.Business2TelephoneNumber, findText, vbBinaryCompare) = 1 Then
    itemContact.Business2TelephoneNumber = VBA.Replace(itemContact.Business2TelephoneNumber, findText, replaceText, 1, 1, vbBinaryCompare)
    End If

    If InStrB(1, itemContact.BusinessFaxNumber, findText, vbBinaryCompare) = 1 Then
    itemContact.BusinessFaxNumber = VBA.Replace(itemContact.BusinessFaxNumber, findText, replaceText, 1, 1, vbBinaryCompare)
    End If

    If InStrB(1, itemContact.CallbackTelephoneNumber, findText, vbBinaryCompare) = 1 Then
    itemContact.CallbackTelephoneNumber = VBA.Replace(itemContact.CallbackTelephoneNumber, findText, replaceText, 1, 1, vbBinaryCompare)
    End If

    If InStrB(1, itemContact.CarTelephoneNumber, findText, vbBinaryCompare) = 1 Then
    itemContact.CarTelephoneNumber = VBA.Replace(itemContact.CarTelephoneNumber, findText, replaceText, 1, 1, vbBinaryCompare)
    End If

    If InStrB(1, itemContact.CompanyMainTelephoneNumber, findText, vbBinaryCompare) = 1 Then
    itemContact.CompanyMainTelephoneNumber = VBA.Replace(itemContact.CompanyMainTelephoneNumber , findText, replaceText, 1, 1, vbBinaryCompare)
    End If

    If InStrB(1, itemContact.Home2TelephoneNumber, findText, vbBinaryCompare) = 1 Then
    itemContact.Home2TelephoneNumber = VBA.Replace(itemContact.Home2TelephoneNumber, findText, replaceText, 1, 1, vbBinaryCompare)
    End If

    If InStrB(1, itemContact.HomeFaxNumber, findText, vbBinaryCompare) = 1 Then
    itemContact.HomeFaxNumber = VBA.Replace(itemContact.HomeFaxNumber, findText, replaceText, 1, 1, vbBinaryCompare)
    End If

    If InStrB(1, itemContact.HomeTelephoneNumber, findText, vbBinaryCompare) = 1 Then
    itemContact.HomeTelephoneNumber = VBA.Replace(itemContact.HomeTelephoneNumber, findText, replaceText, 1, 1, vbBinaryCompare)
    End If

    If InStrB(1, itemContact.MobileTelephoneNumber, findText, vbBinaryCompare) = 1 Then
    itemContact.MobileTelephoneNumber = VBA.Replace(itemContact.MobileTelephoneNumber, findText, replaceText, 1, 1, vbBinaryCompare)
    End If

    If InStrB(1, itemContact.OtherFaxNumber, findText, vbBinaryCompare) = 1 Then
    itemContact.OtherFaxNumber = VBA.Replace(itemContact.OtherFaxNumber, findText, replaceText, 1, 1, vbBinaryCompare)
    End If

    If InStrB(1, itemContact.OtherTelephoneNumber, findText, vbBinaryCompare) = 1 Then
    itemContact.OtherTelephoneNumber = VBA.Replace(itemContact.OtherTelephoneNumber, findText, replaceText, 1, 1, vbBinaryCompare)
    End If

    If InStrB(1, itemContact.PrimaryTelephoneNumber, findText, vbBinaryCompare) = 1 Then
    itemContact.PrimaryTelephoneNumber = VBA.Replace(itemContact.PrimaryTelephoneNumber, findText, replaceText, 1, 1, vbBinaryCompare)
    End If

    If InStrB(1, itemContact.RadioTelephoneNumber, findText, vbBinaryCompare) = 1 Then
    itemContact.RadioTelephoneNumber = VBA.Replace(itemContact.RadioTelephoneNumber, findText, replaceText, 1, 1, vbBinaryCompare)
    End If
    itemContact.Save
    Next

    MsgBox "Da xong!"
    End Sub
     

Chia sẻ trang này