#1
|
|||
|
|||
Copy Excel sheet (contacts) to Outlook Contacts using VBA
Looking to copy a sheet of Contacts in Excel to a specific Contact folder in Outlook using VBA
I've found this code for Excel and it works for the default Contact folder in Outlook. I'm wanting to be able to SELECT what Contact folder it imports into (not use the default). Any help would be appreciated. I'm using Outlook 2010. Thanks Chris Code:
Option Explicit Dim bWeStartedOutlook As Boolean Sub test() Dim success As Boolean success = CreateContactsFromList End Sub Function CreateContactsFromList() As Boolean ' creates contacts in bulk from Excel worksheet ' Col A: First Name ' Col B: Last Name ' Col C: Email Address ' Col D: Company Name ' Col E: Business Telephone ' Col F: Business Fax ' Col G: Home Phone ' Row 1 should be a header row On Error GoTo ErrorHandler Dim lNumRows As Long Dim lNumCols As Long Dim lCount As Long Dim varContactInfo As Variant Dim olContact As Object ' Outlook.ContactItem Dim strCurrentFirstName As String Dim strCurrentLastName As String Dim strCurrentEmailAddr As String Dim strCurrentCompany As String Dim strCurrentBusinessPhone As String Dim strCurrentBusinessFax As String Dim strCurrentHomePhone As String ' figure out how big our array needs to be, and size appropriately lNumRows = Sheet1.Range(Range("A2"), Range("A" & Rows.Count).End(xlUp)).Count lNumCols = Sheet1.Range(Range("A1"), Range("IV1").End(xlToLeft)).Count ReDim varContactInfo(1 To lNumRows, 1 To lNumCols) varContactInfo = Range(Cells(2, 1), Cells(lNumRows + 1, lNumCols)) ' get Outlook Dim olApp As Object ' Outlook.Application Set olApp = GetOutlookApp lCount = 1 Do Until lCount > lNumRows ' assign variant values to intermediate string varbs strCurrentFirstName = varContactInfo(lCount, 1) strCurrentLastName = varContactInfo(lCount, 2) strCurrentEmailAddr = varContactInfo(lCount, 3) strCurrentCompany = varContactInfo(lCount, 4) strCurrentBusinessPhone = varContactInfo(lCount, 5) strCurrentBusinessFax = varContactInfo(lCount, 6) strCurrentHomePhone = varContactInfo(lCount, 7) ' CreateItem will create a contact in the default folder Set olContact = olApp.CreateItem(2) ' olContactItem With olContact .FirstName = strCurrentFirstName .LastName = strCurrentLastName '.FullName = strCurrentLastName & ", " & strCurrentFirstName .Email1Address = strCurrentEmailAddr .CompanyName = strCurrentCompany .BusinessTelephoneNumber = strCurrentBusinessPhone .BusinessFaxNumber = strCurrentBusinessFax .HomeTelephoneNumber = strCurrentHomePhone End With olContact.Close 0 'olSave lCount = lCount + 1 Loop CreateContactsFromList = True GoTo ExitProc ErrorHandler: CreateContactsFromList = False ExitProc: Set olContact = Nothing If bWeStartedOutlook Then olApp.Quit End If Set olApp = Nothing End Function Function GetOutlookApp() As Object On Error Resume Next Set GetOutlookApp = GetObject(, "Outlook.Application") If Err.Number <> 0 Then Set GetOutlookApp = CreateObject("Outlook.Application") bWeStartedOutlook = True End If On Error GoTo 0 End Function |
Tags |
excel export, outlook contacts |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Copy Outlook 2007 "AutoComplete Contacts” to Outlook 2010 | zillah | Outlook | 0 | 09-13-2013 08:37 PM |
How to Copy data from Outlook mail and Paste it in a Excel sheet? | padhu1989 | Outlook | 0 | 09-11-2012 04:07 AM |
How to automatic save Sending or replying contacts e-mails into contacts? | biologus | Outlook | 1 | 09-12-2011 01:14 PM |
Syncing MS outlook contacts with contacts from outlook based programs | novax | Outlook | 0 | 08-07-2011 10:10 PM |
Outlook contacts – Yahoo contacts | Jamal NUMAN | Outlook | 0 | 11-21-2010 07:09 PM |