Question

如何使用VBA将多个vCard VCF联系人文件导入Outlook 2007

Answer 1

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

Answer 2

我遇到的错误很少，下面是对我有用的错误。只需更改目录的路径，它就可以工作。目录应包含“.vcf”文件（数百/以上的任何数字）。

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

Answer 3

这是基于http://www.outlookcode.com/codedetail.aspx?id=212。确保只打开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

如何使用VBA将多个vCard VCF联系人文件导入Outlook 2007

3 个答案: