outlook 宏 自动导入通讯录

Sub 导入联系人到某某某文件夹()

'1.需建立有某某某文件夹；导入前请清空该文件夹

    Dim c As Object
    Dim OutlookApp           As Object 'Outlook.Application
    Dim myNamespace, myFolder, myItem       As Object 'Outlook.Namespace
    Dim myNewFolder         As Object
    Dim MsgFile             As Object
    Dim path                As String
    Dim myMsgFile           As String
    Dim i                   As Integer
 
    Set OutlookApp = CreateObject("outlook.application")
    Set myNamespace = OutlookApp.GetNamespace("MAPI")
    Set myFolder = myNamespace.GetDefaultFolder(olFolderContacts)
   
'获取某某某文件夹(联系人),并清空

    Set myNewFolder = myFolder.Folders("某某某")
 
    Set myItem = myNewFolder.Items
    i = myNewFolder.Items.Count
    Do While i > 0
        myItem(myNewFolder.Items.Count).Delete
        i =