Consulting

Results 1 to 8 of 8

Thread: Export Contacts to Individual VCards

  1. #1
    VBAX Regular
    Joined
    Sep 2005
    Location
    Rome
    Posts
    20
    Location

    Export Contacts to Individual VCards

    Hi all,
    Quick thanks to everyone who makes this site the success it is.

    Does anyone have the same problem as me?
    I'd like to export my contacts to VCards. This means that each contact should be a separate file.

    Any help?

    GSD

  2. #2
    VBAX Master
    Joined
    Jul 2006
    Location
    Belgium
    Posts
    1,286
    Location
    First, select a bunch of contacts with ctrl + left mouse click. Then perform this macro. Contacts will be saved to C:\Data\Vcards . The directory must be present or you'll get an error.[VBA]Sub save_contacts()
    Const mypath As String = "C:\Data\Vcards\"
    Dim mycontact As Outlook.ContactItem
    For Each mycontact In Outlook.ActiveExplorer.Selection
    mycontact.SaveAs mypath & mycontact & ".vcf", Type:=olVCard
    Next mycontact
    End Sub[/VBA]

  3. #3
    VBAX Regular
    Joined
    Sep 2005
    Location
    Rome
    Posts
    20
    Location
    Nice one - and so fast, too!
    That piece of code worked a treat, TX a million

    GSD

  4. #4
    VBAX Regular
    Joined
    Nov 2007
    Posts
    31
    Location
    Charlize, I am new to this forum and VBA, and I really like the code provided above. Is there a way to browse to a folder location when the macro runs instead of having it hard-coded to c:\Data\Vcards?

  5. #5
    VBAX Master
    Joined
    Jul 2006
    Location
    Belgium
    Posts
    1,286
    Location
    Yes, there are several ways. I'll give you one possibility. But the folder must already be present.[VBA]Option Explicit
    Private Const BIF_RETURNONLYFSDIRS As Long = &H1
    Private Const BIF_DONTGOBELOWDOMAIN As Long = &H2
    Private Const BIF_RETURNFSANCESTORS As Long = &H8
    Private Const BIF_BROWSEFORCOMPUTER As Long = &H1000
    Private Const BIF_BROWSEFORPRINTER As Long = &H2000
    Private Const BIF_BROWSEINCLUDEFILES As Long = &H4000
    Private Const MAX_PATH As Long = 260
    Type BrowseInfo
    hOwner As Long
    pidlRoot As Long
    pszDisplayName As String
    lpszINSTRUCTIONS As String
    ulFlags As Long
    lpfn As Long
    lParam As Long
    iImage As Long
    End Type
    Type SHFILEOPSTRUCT
    hwnd As Long
    wFunc As Long
    pFrom As String
    pTo As String
    fFlags As Integer
    fAnyOperationsAborted As Boolean
    hNameMappings As Long
    lpszProgressTitle As String
    End Type
    Declare Function SHGetPathFromIDListA Lib "shell32.dll" ( _
    ByVal pidl As Long, _
    ByVal pszBuffer As String) As Long
    Declare Function SHBrowseForFolderA Lib "shell32.dll" ( _
    lpBrowseInfo As BrowseInfo) As Long

    Function BrowseFolder(Optional Caption As String = "") As String
    Dim BrowseInfo As BrowseInfo
    Dim FolderName As String
    Dim ID As Long
    Dim Res As Long
    With BrowseInfo
    .hOwner = 0
    .pidlRoot = 0
    .pszDisplayName = String$(MAX_PATH, vbNullChar)
    .lpszINSTRUCTIONS = Caption
    .ulFlags = BIF_RETURNONLYFSDIRS
    .lpfn = 0
    End With
    FolderName = String$(MAX_PATH, vbNullChar)
    ID = SHBrowseForFolderA(BrowseInfo)
    If ID Then
    Res = SHGetPathFromIDListA(ID, FolderName)
    If Res Then
    BrowseFolder = Left$(FolderName, InStr(FolderName, vbNullChar) - 1)
    End If
    End If
    End Function
    Sub Save_Contacts()
    Dim mypath As String
    Dim mycontact As Outlook.ContactItem
    mypath = BrowseFolder(Caption:="Select folder to save contacts ...")
    If mypath = vbNullString Then
    MsgBox "No destinationfolder selected", vbInformation
    Exit Sub
    Else
    For Each mycontact In Outlook.ActiveExplorer.Selection
    mycontact.SaveAs mypath & "\" & mycontact & ".vcf", Type:=olVCard
    Next mycontact
    End If
    End Sub
    [/VBA]

  6. #6
    VBAX Regular
    Joined
    Nov 2007
    Posts
    31
    Location
    This worked just fine and I appreciate all your help. Isn't there a way to call an mso object that would normally handle these types of requests - that would also allow you to create a folder if it wasn't there?

  7. #7
    VBAX Master
    Joined
    Jul 2006
    Location
    Belgium
    Posts
    1,286
    Location
    Have you browsed through the KB items ? You should try it ...[VBA]Option Explicit
    Sub Choose_Directory_Or_Create_One()
    Dim mypath As Variant
    mypath = BrowseForFolder("C:\")
    If mypath = False Then
    MsgBox "No directory chosen !", vbExclamation
    Else
    MsgBox "Save to : " & mypath, vbInformation
    End If
    End Sub
    Function BrowseForFolder(Optional OpenAt As Variant) As Variant
    'Function purpose: To Browser for a user selected folder.
    'If the "OpenAt" path is provided, open the browser at that directory
    'NOTE: If invalid, it will open at the Desktop level
    Dim ShellApp As Object
    'Create a file browser window at the default folder
    Set ShellApp = CreateObject("Shell.Application"). _
    BrowseForFolder(0, "Please choose a folder", 0, OpenAt)
    'Set the folder to that selected. (On error in case cancelled)
    On Error Resume Next
    BrowseForFolder = ShellApp.self.Path
    On Error GoTo 0
    'Destroy the Shell Application
    Set ShellApp = Nothing
    'Check for invalid or non-entries and send to the Invalid error
    'handler if found
    'Valid selections can begin L: (where L is a letter) or
    '\\ (as in \\servername\sharename. All others are invalid
    Select Case Mid(BrowseForFolder, 2, 1)
    Case Is = ":"
    If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
    Case Is = "\"
    If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
    Case Else
    GoTo Invalid
    End Select
    Exit Function
    Invalid:
    'If it was determined that the selection was invalid, set to False
    BrowseForFolder = False
    End Function[/VBA]

  8. #8
    Get the simple method and simple tool for exporting Vcard from outlook contacts. Vcard Exporter tool which is safely converts all MS Outlook Contacts to VCF format easily.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •