如何批量导入vCard格式联系人到Outlook

1，把所有Vcards文件放在一个文件夹内。C:\VCARDS（这个路径需要和代码中的路径相同）

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

3，单击“工具”–>“引用”，勾中“Windows Script Host Object Model ”和“Microsoft Scripting Runtime”

4，单击“插入”–>“模块”，把下列代码粘帖进去, 然后运行
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 strVCName
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