outlook2007利用宏批量导入vcf文件为联系人

 

Sub OpenSaveVCard()

rem 批量文件改名(去除文件名中的“_”和空格)
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
strName = Replace(strVCName, "_", "")
strName = Replace(strName, " ", "")
Name strVCName As strName
 Next
End Sub


Sub OpenSaveVCard1()

rem 批量导入
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

阅读更多
文章标签: each c
想对作者说点什么? 我来说一句

手机电话簿转换工具(vcf_csv_dat)

2012年07月15日 191KB 下载

没有更多推荐了,返回首页

关闭
关闭