Outlook '97 - Importing Excel Data 1

[kristy123]

I have created a new Outlook Tasks folder and I need to import data from an Excel file.
In the new Outlook folder, I removed all the default columns and created new fields (column headings) in this folder to match the colum headings on my Excel file. When I get to the step in the Import Data process (from Excel to Outlook) where I map my Excel data into the Outlook data fields, the only Outlook fields that are provided to map to are default fields, and my custom fields are not in the list. How can I change these Outlook fields to my custom fields?

Thanks!

 

[Databaseguy]

You'll probably have to use VBA. The following routine opens a .CSV file into excel, deletes some columns, renames the remaining columns, and pulls the Spreadsheet into the Outlook contacts folder. You;ll have to modify it to suit
your needs.



Private Sub cmdImport_Click()

'----------------------------------
'Tyrone Lumley
'Tempo
'7/16/01
'Pulls GW address book into Outlook
'----------------------------------

Dim objExcel As Excel.Application 'Excel Object
Dim myNS As NameSpace 'Name Space Object
Dim myFolder As MAPIFolder 'Folder Object
Dim myItems As Items 'Items Collection
Dim myItem As ContactItem 'Contact Item
Dim topCel As Range 'Excel Range, top
Dim bottomCel As Range 'Excel range, bottom
Dim Countz 'Counter, I used Z to prevent problems with intrensic functions
Set myNS = Application.GetNamespace("MAPI&quot 'Instanciate MAPI NameSpace
Set myFolder = myNS.GetDefaultFolder(olFolderContacts) 'Open Contacts Folder
Set myItems = myFolder.Items 'Items collection in contacts
Set objExcel = New Excel.Application 'Instanciate Excel

'Make it visible (default is invisible) and add a new workbook
With objExcel
.Visible = True
'Open the Groupwise Address book. It has a .NAB extensoin, but excel recognizes it. Change your filename here. If it'sa plain vanilla spreadsheet (This is a CSV), you won't need the TextQualifier,Semicolon, Etc.

.Workbooks.OpenText FileName:="C:\Pers.NAB", Origin:=xlWindows, StartRow:= _
1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=True, _
Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), Array( _
3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10 _
, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15, 1), Array(16, 1), _
Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 1), Array(22, 1), Array( _
23, 1), Array(24, 1), Array(25, 1), Array(26, 1), Array(27, 1), Array(28, 1), Array(29, 1), _
Array(30, 1), Array(31, 1), Array(32, 1))
'Get rid of columns we don't need
.Columns("A:A&quot.Select
.Selection.ClearContents
.Selection.Delete Shift:=xlToLeft
.Columns("D&quot.Select
.Selection.Delete Shift:=xlToLeft
.Columns("H:AE&quot.Select
.Selection.Delete Shift:=xlToLeft
'Set column titles
.Range("A1&quot.Select
.ActiveCell.FormulaR1C1 = "Display Name"
.Range("B1&quot.Select
.ActiveCell.FormulaR1C1 = "Extension"
.Range("C1&quot.Select
.ActiveCell.FormulaR1C1 = "Department"
.Range("D1&quot.Select
.ActiveCell.FormulaR1C1 = "E-Mail"
.Range("E1&quot.Select
.ActiveCell.FormulaR1C1 = "First Name"
.Range("F1&quot.Select
.ActiveCell.FormulaR1C1 = "Last Name"
.Range("G1&quot.Select
.ActiveCell.FormulaR1C1 = "Title"
'Find out how many rows
Set topCel = ActiveCell 'First row
Set bottomCel = objExcel.Cells((65536), topCel.Column).End(xlUp) 'Last row
Countz = bottomCel.Row ' Last row
.Range("a2&quot.Select ' First row w/data change if somewhere different
For i = 1 To Countz
'Add a new contact. You'll change this to olTaskItem
Set myItem = Application.CreateItem(olContactItem)
With myItem
'Populate fields. You're Custom Fields willgo here.
'Your Field Name = The Column

.FullName = objExcel.ActiveCell.Offset(0, 0)
.OfficeLocation = objExcel.ActiveCell.Offset(0, 1)
.Department = objExcel.ActiveCell.Offset(0, 2)
.Email1Address = objExcel.ActiveCell.Offset(0, 3)
.FirstName = objExcel.ActiveCell.Offset(0, 4)
.LastName = objExcel.ActiveCell.Offset(0, 5)
.Title = objExcel.ActiveCell.Offset(0, 6)
End With
myItem.Close (olSave) 'Close & save it
'Go to the next row
objExcel.ActiveCell.Offset(1, 0).Activate
'Advance the counter
Next i
End With
'Close the workbook & quit Excel
objExcel.ActiveWorkbook.Close (False)
objExcel.Application.Quit
'Release all of the variables
Set myNS = Nothing
Set myFolder = Nothing
Set myItems = Nothing
Set myItem = Nothing
Set objExcel = Nothing
Me.Hide
End Sub