2023年12月14日发(作者：)

用vba实现outlook vcard文件批量导出

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

Sub ExportVcards()

Dim MyContacts As lder

Dim ContItem As tItem

Dim FileName As String

Set MyContacts =

espace("MAPI").GetDefaultFolder(olFolderContacts)

For Each ContItem In

FileName = "d:Contacts" & & ".vcf"

FileName, olVCard

Next

End Sub

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

然后运行, 如果失败, 请检查”c:/Contacts”文件夹是否存在 (不存在则要先创建), 以及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 ell

Dim objOL As ation

Dim colInsp As tors

Dim strVCName As String

Dim fso As stemObject

Dim fsDir As

Dim fsFile As Dim vCounter As Integer

Set fso = New stemObject

Set fsDir = der("C:VCARDS")

For Each fsFile In

strVCName = "C:VCARDS" &

Set objOL = CreateObject("ation")

Set collnsp = tors

If = 0 Then

Set objWSHShell = CreateObject("")

Chr(34) & strVCName & Chr(34)

Set colInsp = tors

If Err = 0 Then

Do Until = 1

DoEvents

Loop

(1).

(1).Close olDiscard

Set colInsp = Nothing

Set objOL = Nothing

Set objWSHShell = Nothing

End If

End If

Next

End Sub

注意：不要禁用宏。