Inicio > office > Macro to Bulk Import vCards into Outlook

Macro to Bulk Import vCards into Outlook

Fuente: http://www.slipstick.com/developer/macro-to-bulk-import-vcards/

Fuente 2: http://www.slipstick.com/outlook/contacts/

 

Last reviewed on June 12, 2012

Microsoft Outlook does not support importing multiple vCards – you need to import them one vcard at a time. While this is tolerable for a few, its frustrating when you a large number to import.

This can also be done using VBA, basically automating the process you’d use to do it manually: open each contact, save in your default Contacts folder then close it. Unless you are Superman, the macro will finish long before you would.

Macro to bulk import vcards

Begin by creating a folder named vcards on root of the c:\ drive. The path will be c:\vcards. Copy all your individual vCard files (.vcf) to this folder.

Next open Outlook and press ALT + F11 to open the VBA editor.

Go to Tools, References and select Microsoft Scripting Runtime and Windows Script Host Object Model from the list and place checks in the box next to each and click OK.

Click Insert, Module and copy and paste the following code into the blank module. Save and run the macro to automatically import and save all the individual files into Outlook.

Sub OpenSaveVCard()
    
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
'original code
'strVCName = "C:\vcards\" & fsFile.Name
'Zeda's fix for spaces in filenames
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
Categorías:office Etiquetas: ,
  1. Aún no hay comentarios.
  1. No trackbacks yet.

Responder

Introduce tus datos o haz clic en un icono para iniciar sesión:

Logo de WordPress.com

Estás comentando usando tu cuenta de WordPress.com. Cerrar sesión / Cambiar )

Imagen de Twitter

Estás comentando usando tu cuenta de Twitter. Cerrar sesión / Cambiar )

Foto de Facebook

Estás comentando usando tu cuenta de Facebook. Cerrar sesión / Cambiar )

Google+ photo

Estás comentando usando tu cuenta de Google+. Cerrar sesión / Cambiar )

Conectando a %s

A %d blogueros les gusta esto: