随笔记录——批量导入vCard格式联系人到Outlook

　　网上有从Outlook批量导出Vcard格式的教程说明，但是关于如何将Vcard格式的联系人批量导入到Outlook的教程几乎没有。我在网上找到了以下这些操作步骤，成功了，在这里分享。

1，把所有Vcards文件放在一个文件夹内，例如C:\vcards；

2，打开Outlook的VBA编辑器（ALT + F11 呼出）；

3，单击“工具”–>“引用”，勾中“Windows Script Host Object Model ”；

4，单击“插入”–>“模块”，把下列蓝色字体代码粘帖进去。保存名字例如“A”；

5，单击“工具”–>“运行”–>“宏”，运行刚才保存的名字“A”；

6，运行…。

 

Sub OpenSaveVCard()

  Dim objWSHShell As IWshRuntimeLibrary.IWshShell
  Dim objOL As Outlook.Application
  Dim colInsp As Outlook.Inspectors
  Dim strVCName As String
  Dim fso As Scripting.FileSystemObject
  Dim fsDir As Scripting.Folder
  Dim fsFile As Scripting.File
  Dim vCounter As Integer

  Set fso = New Scripting.FileSystemObject
  Set fsDir = fso.GetFolder("C:\VCARDS")

  For Each fsFile In fsDir.Files

    strVCName = "C:\VCARDS\" & fsFile.Name
    Set objOL = CreateObject("Outlook.Application")
    Set colInsp = objOL.Inspectors
    If colInsp.Count = 0 Then
      Set objWSHShell = CreateObject("WScript.Shell")
      objWSHShell.Run Chr(34) & strVCName & Chr(34)
      Set colInsp = objOL.Inspectors
      If Err = 0 Then
        Do Until colInsp.Count = 1
          DoEvents
        Loop
        colInsp.Item(1).CurrentItem.Save
        colInsp.Item(1).Close olDiscard
        Set colInsp = Nothing
        Set objOL = Nothing
        Set objWSHShell = Nothing
      End If
    End If
  Next
End Sub