2

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

4

3 回答 3

3 
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
于 2011-03-12T00:24:08.013 回答
1

我遇到了一些错误，以下是对我有用的错误。只需更改目录的路径，它将起作用。目录应包含“.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
于 2011-12-24T21:44:57.667 回答
0

这是基于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
于 2010-04-15T15:09:52.367 回答