网上有从Outlook批量导出Vcard格式的教程说明，但是关于如何将Vcard格式的联系人批量导入到Outlook的教程几乎没有。我在网上找到了以下这些操作步骤，成功了，在这里分享。
1，把所有Vcards文件放在一个文件夹内。C:\VCARDS（这个路径需要和代码中的路径相同）
2，打开Outlook的VBA编辑器。（ALT + F11 呼出）
3，单击“工具”–>“引用”，勾中“Windows Script Host Object Model ”和“Microsoft Scripting Runtime”
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 IntegerSet 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 IfNext
End Sub
怎么不行了，是下边这整段复制到宏里啊
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
@peggy:是啊，需要整段复制过去执行。
我也是一整段復制過去的, 但提示沒有定義
因为代码还需要引用“Microsoft Scripting Runtime”，请在VBA的“工具”–>“引用”中勾选“Microsoft Scripting Runtime”即可。
可是工具－引用中没有microsoft scripting runtime
有“Windows Script Host Object Model ”的，你仔细找找看。
谢谢 ,我已经用这个方法成功的导入了,可是 姓氏显示乱码.
其他人是不是也碰到这个问题？
把VCARD文件转换为ASCII
谢谢，我测试是成功的，但是 （”C:\VCARDS”)，这里的双引号用错了中文的，希望大家注意，主人应该是在中文输入法状态下写的代码。
谢谢罗，用英文输入方式。
问题是，即使我用了英文，但显示在博客上时，不知为何就变成了中文。
第三行出错，Dim objOL As Outlook.Application
提示用户定义类型未定义。
我用的是office2007
@cd:真是抱歉，我所用的是office2000，没有问题。在2007上未试过，你再找找有没有其他方法。
非常感谢楼主提供的方法。我的问题已经解决。
其中遇到过一个小问题供后人借鉴：objWSHShell.Run strVCName这行报错
后来发现是不支持文件名中有空格的原因。文件名修改即好。
by theway：我用的是outlook2007
具体是怎么操作呢?
语法错误啊！怎么办？
这么好的方法，一定要顶。
我也能成功导入，但也是乱码·
我用了，引号是有问题，但是改过来后发现只读取了第一个联系人，其它就没有反应了。
我也只读取了第一个联系人。该怎么办？
没有“Windows Script Host Object Model ”怎么办？
狂顶！解决了我的大问题！真是爱死你了！
真的是不能有空格在里面。哎~
感谢楼主。
下面的修改可以修正带空格文件名的错误。
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:\files\Personal\SD_Backup\moto_backup”)
For Each fsFile In fsDir.Files
strVCName = “c:\files\Personal\SD_Backup\moto_backup\” & fsFile.Name
Set objOL = CreateObject(“Outlook.Application”)
Set colInsp = objOL.Inspectors
If colInsp.Count = 0 Then
Set objWSHShell = CreateObject(“WScript.Shell”)
If InStr(fsFile.Name, ” “) > 0 Then
strVCName = “c:\files\Personal\SD_Backup\moto_backup\” & Chr(34) & fsFile.Name & Chr(34)
objWSHShell.Run (Chr(34) & “c:\files\Personal\SD_Backup\moto_backup\” & fsFile.Name & Chr(34))
Else
objWSHShell.Run strVCName
End If
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
我是2007，运行宏，总是提示我“该工程中的宏已经被禁用”
将vcard文件和路径指定好，自己新创建一个模块，直接运行你粘贴上去的代码就可以了。
SHY的程序不错，但运行时屏闪刷新严重，受不了啊。
请在程序中增加两行：
开始运行程序中增加一行，防止运行时屏闪：
Application.ScreenUpdating = False
最后面程序结束前增加一行：
Application.ScreenUpdating = True
outlook 不支持ScreenUpdating 请不要添加