outlook如何批量导出vcard

jason2603

因为需要Googlemail和outlook2010同步，我不想用google的sync软件，能否将outlook批量导出Vcard，然后再从gmail导入？目前我看到outlook只能一个一个导出Vcard，不能批量，谁有办法？

dsd999

用vba实现。

outlook中. 工具->宏, 创建一个新的宏, 名称任意, 输入:

Sub ExportVcards()
Dim MyContacts As Outlook.MAPIFolder
Dim ContItem As Outlook.ContactItem
Dim FileName As String
Set MyContacts = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderContacts)
For Each ContItem In MyContacts.Items
FileName = "d:\Contacts\" & ContItem.FileAs & ".vcf"
ContItem.SaveAs FileName, olVCard
Next
End Sub

注意上面的”c:/Contacts”为输出到的目的文件夹.

然后运行, 如果失败, 请检查”c:/Contacts”文件夹是否存在 (不存在则要先创建), 以及outlook中, 工具->安全性, 是否有权限运行宏.

dsd999

批量导入。

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

注意：不要禁用宏。

caotor

非常好的办法，我也是通过代码导出后，再批量导入安卓手机的

chicklee

其实还有个好办法，全选联系人后选择以vcard格式转发。
这样给自己发个邮件就行了，所有人的vcf文件都在附件中，直接打包下载就ok啦，呵呵