如何导入多个电子名片VCF联系人文件到Outlook 2007中使用VBA

问题描述：

如何使用VBA如何导入多个电子名片VCF联系人文件到Outlook 2007中使用VBA

你能发表一些你试过的代码吗？ – Jeremy 2010-04-15 15:09:10

我找到了一个解决方案，并希望在此发布。 – user202448 2010-04-15 15:11:35

答

Sub OpenSaveVCard() 

    Dim objWSHShell As Object 
    Dim objOL As Outlook.Application 
    Dim colInsp As Outlook.Inspectors 
    Dim strVCName As String 
    Dim vCounter As Integer 
    Dim ff As String 

    ff = Dir("d:\contacts\*.vcf") 

    Do While Len(ff) 

     strVCName = "d:\contacts\" & ff 
     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 

     ff = Dir 

    Loop 

End Sub

答

这是基于关闭的http://www.outlookcode.com/codedetail.aspx?id=212导入多个电子名片VCF联系人文件到Outlook 2007。确保只有主Outlook窗口打开。

Sub OpenSaveVCard() 

Dim objWSHShell As Object 
Dim objOL As Outlook.Application 
Dim colInsp As Outlook.Inspectors 
Dim strVCName As String 
Dim vCounter As Integer 
Dim ff As String 

ff = Dir("C:\Contacts\*.vcf") 

Do While Len(ff) 

    strVCName = "C:\Contacts\" & ff 
    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 

    ff = Dir 

Loop 

End Sub

答

我面临几个误区，下面是它为我工作的人。只需更改目录的路径，它将起作用。目录应该包含“.vcf”文件（数以百计/ thounsands以上的任何数字）。

Sub OpenSaveVCard() 

    Dim objWSHShell As Object 
    'Dim objOL As Outlook.Application 
    'Dim colInsp As Outlook.Inspectors 
    Dim strVCName As String 
    Dim vCounter As Integer 
    Dim ff As String 

    ff = Dir("D:\Contacts\*.vcf") 
    Do While Len(ff) 
     On Error Resume Next 
     strVCName = "D:\Upender\Contacts\" & ff 
     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 
      End If 
     End If 

     ff = Dir() 
    Loop 
    Set colInsp = Nothing 
    Set objOL = Nothing 
    Set objWSHShell = Nothing 
End Sub

如何导入多个电子名片VCF联系人文件到Outlook 2007中使用VBA

相关推荐