Sub 주소록전화번호숫자만()
Dim objOL As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim objContact As Outlook.ContactItem
Dim objItems As Outlook.Items
Dim objContactsFolder As Outlook.MAPIFolder
Dim obj As Object
On Error Resume Next
Set objOL = CreateObject("Outlook.Application")
Set objNS = objOL.GetNamespace("MAPI")
Set objContactsFolder = objNS.GetDefaultFolder(olFolderContacts)
Set objItems = objContactsFolder.Items
For Each obj In objItems
'Test for contact and not distribution list
If obj.Class = olContact Then
Set objContact = obj
With objContact
.AssistantTelephoneNumber = RemoveChar(.AssistantTelephoneNumber)
.Business2TelephoneNumber = RemoveChar(.Business2TelephoneNumber)
.BusinessFaxNumber = RemoveChar(.BusinessFaxNumber)
.BusinessTelephoneNumber = RemoveChar(.BusinessTelephoneNumber)
.CallbackTelephoneNumber = RemoveChar(.CallbackTelephoneNumber)
.CarTelephoneNumber = RemoveChar(.CarTelephoneNumber)
.CompanyMainTelephoneNumber = RemoveChar(.CompanyMainTelephoneNumber)
.Home2TelephoneNumber = RemoveChar(.Home2TelephoneNumber)
.HomeFaxNumber = RemoveChar(.HomeFaxNumber)
.HomeTelephoneNumber = RemoveChar(.HomeTelephoneNumber)
.MobileTelephoneNumber = RemoveChar(.MobileTelephoneNumber)
.OtherTelephoneNumber = RemoveChar(.OtherTelephoneNumber)
.PrimaryTelephoneNumber = RemoveChar(.PrimaryTelephoneNumber)
.Save
End With
End If
Err.Clear
Next
Set objOL = Nothing
Set objNS = Nothing
Set obj = Nothing
Set objContact = Nothing
Set objItems = Nothing
Set objContactsFolder = Nothing
End Sub
Function RemoveChar(strParam As String) As String
Dim strNumber As String
Dim i As Integer
strNumber = ""
For i = 1 To Len(strParam)
If (IsNumeric(Mid(strParam, i, 1)) = True) Then 'number
strNumber = strNumber + Mid(strParam, i, 1)
End If
Next
RemoveChar = strNumber
End Function
댓글을 달아 주세요