Be without fear in the face of your enemies, Be brave and upright that God may love thee, Speak the truth always even if it lead to your death, Safeguard the helpless and do no wrong. (Kingdom of Heaven)

某招聘会现场。 

在拥挤的城市里面寻找幸福，还是在平静的内心里寻求幸福？ 

从Outlook批量导入Vcard格式的教程说明

原文链接：http://blog.sina.com.cn/s/blog_496816920100gxyt.html

从Outlook批量导入Vcard格式的教程说明 (2010-01-31 16:56:29)转载
标签： 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 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 collnsp = objOL.Inspectors
If collnsp.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
注意：不要禁用宏。