Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 09-24-2020, 08:39 PM
cjamps cjamps is offline Macro - Export Contacts csv Windows 8 Macro - Export Contacts csv Office 2010 32bit
Novice
Macro - Export Contacts csv
 
Join Date: Mar 2017
Posts: 16
cjamps is on a distinguished road
Default Macro - Export Contacts csv

I save all my contacts in 1 contact folder. Some have email address and some don't. I want to export some of the ones that do have email addresses so I can import them into mailchimp as a csv fuke. Is there a simple way to record all the steps into a macro?

manually I am
1. highlighting the contacts
2. copy to another contact folder for export.
3. export contact folder to csv file.
4. edit csv file to match mailchimp import

thank you.
Reply With Quote
  #2  
Old 09-25-2020, 12:02 AM
gmayor's Avatar
gmayor gmayor is offline Macro - Export Contacts csv Windows 10 Macro - Export Contacts csv Office 2016
Expert
 
Join Date: Aug 2014
Posts: 4,101
gmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud of
Default

There is no VBA recorder in Outlook, however the following will do what you require. You may have to add or remove fields to fit your brief, but the principles remain the same.

Code:
Sub ExportContactsToExcel()
Dim olItem As Outlook.ContactItem
Dim rCount As Long
Dim sText As String
Dim vItem As Variant
Dim i As Long
Dim fso As Object
Dim Fileout As Object
Const strPath As String = "C:\Path\OutlookContacts.csv"        'the path of the csv"

    If Application.ActiveExplorer.Selection.Count = 0 Then
        MsgBox "No Items selected!", vbCritical, "Error"
        Exit Sub
    End If
    
    sText = Chr(34) & "FirstName" & Chr(34)
    sText = sText & Chr(44) & Chr(34) & "LastName" & Chr(34)
    sText = sText & Chr(44) & Chr(34) & "CompanyName" & Chr(34)
    sText = sText & Chr(44) & Chr(34) & "Street" & Chr(34)
    sText = sText & Chr(44) & Chr(34) & "City" & Chr(34)
    sText = sText & Chr(44) & Chr(34) & "State" & Chr(34)
    sText = sText & Chr(44) & Chr(34) & "PostalCode" & Chr(34)
    sText = sText & Chr(44) & Chr(34) & "POBoxNum" & Chr(34)
    sText = sText & Chr(44) & Chr(34) & "Country" & Chr(34)
    sText = sText & Chr(44) & Chr(34) & "EMail" & Chr(34)
    sText = sText & Chr(44) & Chr(34) & "BusinessPhone" & Chr(34)
    sText = sText & Chr(44) & Chr(34) & "HomePhone" & Chr(34)
    sText = sText & Chr(44) & Chr(34) & "MobilePhone" & Chr(34)

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set Fileout = fso.CreateTextFile(strPath, True, True)
    Fileout.WriteLine sText

    For Each olItem In Application.ActiveExplorer.Selection
        If olItem.Email1Address <> "" Then
            sText = Chr(34) & Trim(olItem.FirstName) & Chr(34)
            sText = sText & Chr(44) & Chr(34) & Trim(olItem.LastName) & Chr(34)
            sText = sText & Chr(44) & Chr(34) & Trim(olItem.CompanyName) & Chr(34)
            sText = sText & Chr(44) & Chr(34) & Trim(olItem.MailingAddressStreet) & Chr(34)
            sText = sText & Chr(44) & Chr(34) & Trim(olItem.MailingAddressCity) & Chr(34)
            sText = sText & Chr(44) & Chr(34) & Trim(olItem.MailingAddressState) & Chr(34)
            sText = sText & Chr(44) & Chr(34) & Trim(olItem.MailingAddressPostalCode) & Chr(34)
            sText = sText & Chr(44) & Chr(34) & Trim(olItem.MailingAddressPostOfficeBox) & Chr(34)
            sText = sText & Chr(44) & Chr(34) & Trim(olItem.MailingAddressCountry) & Chr(34)
            sText = sText & Chr(44) & Chr(34) & Trim(olItem.Email1Address) & Chr(34)
            sText = sText & Chr(44) & Chr(34) & Trim(olItem.BusinessTelephoneNumber) & Chr(34)
            sText = sText & Chr(44) & Chr(34) & Trim(olItem.HomeTelephoneNumber) & Chr(34)
            sText = sText & Chr(44) & Chr(34) & Trim(olItem.MobileTelephoneNumber) & Chr(34)
            Fileout.WriteLine sText
        End If
        DoEvents
    Next olItem
    Fileout.Close
lbl_Exit:
    Set olItem = Nothing
    Set fso = Nothing
    Set Fileout = Nothing
    Exit Sub
End Sub
__________________
Graham Mayor - MS MVP (Word) (2002-2019)
Visit my web site for more programming tips and ready made processes www.gmayor.com
Reply With Quote
Reply

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
Export address book, not just contacts Mickeddie Outlook 0 04-25-2019 02:12 PM
Export single category from contacts list ksimmonds Outlook 0 04-25-2018 02:04 AM
Macro - Export Contacts csv How to export contacts in Windows Live Mail BW in Florida Other Software 1 10-28-2016 05:00 PM
Export/Import Contacts in Outlook 2010 davidoma2 Outlook 4 07-24-2012 04:48 PM
How do I export my contacts to an Excel spreadsheet? Shawn76 Outlook 2 05-22-2010 07:54 AM

Other Forums: Access Forums

All times are GMT -7. The time now is 03:02 PM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2024, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2024 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft