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

网上有从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 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

如何批量导入vCard格式联系人到Outlook》上有30条评论

  1. 怎么不行了,是下边这整段复制到宏里啊
    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

  2. 因为代码还需要引用“Microsoft Scripting Runtime”,请在VBA的“工具”–>“引用”中勾选“Microsoft Scripting Runtime”即可。

  3. 谢谢,我测试是成功的,但是 (”C:\VCARDS”),这里的双引号用错了中文的,希望大家注意,主人应该是在中文输入法状态下写的代码。

    • 谢谢罗,用英文输入方式。
      问题是,即使我用了英文,但显示在博客上时,不知为何就变成了中文。

  4. 第三行出错,Dim objOL As Outlook.Application
    提示用户定义类型未定义。
    我用的是office2007

    • @cd:真是抱歉,我所用的是office2000,没有问题。在2007上未试过,你再找找有没有其他方法。

  5. 非常感谢楼主提供的方法。我的问题已经解决。
    其中遇到过一个小问题供后人借鉴:objWSHShell.Run strVCName这行报错
    后来发现是不支持文件名中有空格的原因。文件名修改即好。

    by theway:我用的是outlook2007

  6. Pingback引用通告: vcf文件批量导入outlook | yeppfox

  7. 我用了,引号是有问题,但是改过来后发现只读取了第一个联系人,其它就没有反应了。

  8. 感谢楼主。
    下面的修改可以修正带空格文件名的错误。

    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

  9. 我是2007,运行宏,总是提示我“该工程中的宏已经被禁用”

    • 将vcard文件和路径指定好,自己新创建一个模块,直接运行你粘贴上去的代码就可以了。

  10. SHY的程序不错,但运行时屏闪刷新严重,受不了啊。
    请在程序中增加两行:
    开始运行程序中增加一行,防止运行时屏闪:
    Application.ScreenUpdating = False
    最后面程序结束前增加一行:
    Application.ScreenUpdating = True

  11. Pingback引用通告: 批量导入.vcf文件到Outlook | Strawhat Chan

发表评论

电子邮件地址不会被公开。 必填项已用*标注