Microsoft Office Tutorials and References
In Depth Information
Importing Your Contacts from Outlook
If oApp Is Nothing Then¶
Set oApp = CreateObject("Outlook.Application")¶
OutlookRunning = False¶
OutlookRunning = True¶
End If¶
Set oNameSpace = oApp.GetNamespace("MAPI")¶
Set oFolder = oNameSpace.GetDefaultFolder(10) 'olFolderContacts = 10¶
'Create a new sheet for this¶
Set WS = Workbooks.Add(xlWorksheet).Worksheets(1)¶
With WS.Range("A1").Resize(1, 5)¶
.Value = Array("Full Name", "Last name", "First name", _¶
"Email", "Business phone")¶
.Font.Bold = True¶
End With¶
'Loop through the available contacts¶
For Each oContact In oFolder.Items¶
'Is it a Contact or a Distribution List¶
If oContact.class = 40 Then 'olContact = 40¶
'Next available row¶
With WS.Cells(WS.Rows.Count, 1).End(xlUp).Offset(1)¶
.Value = oContact.FullName¶
.Offset(, 1).Value = oContact.LastName¶
.Offset(, 2).Value = oContact.FirstName¶
.Offset(, 3).Value = oContact.Email1Address¶
.Offset(, 4).Value = oContact.BusinessTelephoneNumber¶
'Other available properties¶
'.Offset(, 5).Value = oContact.Birthday¶
'.Offset(, 6).Value = oContact.BusinessAddress¶
'.Offset(, 7).Value = oContact.BusinessAddressCity¶
'.Offset(, 8).Value = oContact.CompanyName¶
'.Offset(, 9).Value = oContact.Email1DisplayName¶
'.Offset(, 10).Value = oContact.Gender¶
'.Offset(, 11).Value = oContact.HomeAddress¶
'.Offset(, 12).Value = oContact.HomeAddressCity¶
'.Offset(, 13).Value = oContact.JobTitle¶
'.Offset(, 14).Value = oContact.MailingAddress¶
'.Offset(, 15).Value = oContact.MailingAddressCity¶
'.Offset(, 16).Value = oContact.NickName¶
End With¶
End If¶
Next oContact¶
'Resize columns¶
'Check to see if Outlook needs to be closed¶
If Not OutlookRunning Then¶
End If¶
Search JabSto ::

Custom Search