Hi all,

Can someone help with the following problem -

I have outlook tasks with custom fields and lots of data therein....I need a
script to either copy or paste the tasks into an excel worksheet. I know I
can copy and paste from outlook tasks but the custom fields with a multiline
property do not foramt in the receiving excel sheet....

I had some great help from Sue Mosher at outlookcode.com in how to import
from excel to outlook tasks and custom fields but cannot work out how to
reverse engineer it - code below:

'================================================= ============
' ExcelDLToContacts
' Listing 24.4
'-------------------------------------------------------------
' Purpose : Create new contacts from data in an Excel Worksheet
'================================================= ============
Sub ExcelDLToContacts()

Dim objExcel
Dim objWB
Dim objWS
Dim objRange
Dim objApp As Outlook.Application
Dim objTask As Outlook.TaskItem
Dim intRowCount As Integer
Dim I As Integer
On Error Resume Next

m_blnWeOpenedExcel = False
Set objExcel = GetObject(, "Excel.Application")
If objExcel Is Nothing Then
Set objExcel = CreateObject("Excel.Application")
m_blnWeOpenedExcel = True
End If
On Error GoTo 0
Set objWB = objExcel.Workbooks.Add("C:\Documents and
Settings\turnerc\Personal\Mapped.xls")
Set objWS = objWB.Worksheets(1)
Set objRange = objWS.Range("test")
intRowCount = objRange.Rows.Count
If intRowCount 0 Then
Set objApp = CreateObject("Outlook.Application")
For I = 1 To intRowCount
Set objTask = objApp.CreateItem(olTaskItem)
With objTask
.Subject = objRange.Cells(I, 3)
.Contacts = objRange.Cells(I, 2)
.Categories = objRange.Cells(I, 7)
.BillingInformation = objRange.Cells(I, 9)
.Mileage = objRange.Cells(I, 10)
.Role = objRange.Cells(I, 11)
.Save
End With
Next
End If
objWB.Close False
'Call RestoreExcel

Set objExcel = Nothing
Set objWB = Nothing
Set objWS = Nothing
Set objRange = Nothing
Set objApp = Nothing
Set objTask = Nothing
End Sub























Sub ConvertFields()
Dim objApp As Application
Dim objNS As NameSpace
Dim objFolder As MAPIFolder
Dim objItems As Items
Dim objItem As Object

Set objApp = CreateObject("Outlook.Application")
Set objNS = objApp.GetNamespace("MAPI")
Set objFolder = objNS.PickFolder
If Not objFolder Is Nothing Then
Set objItems = objFolder.Items
For Each objItem In objItems
' make sure you have a Contact item
If objItem.Class = olTask Then
' convert to your published custom form
objItem.MessageClass = "IPM.Task.Liberata TMS Form"
' copy data to your custom fields
'objItem.UserProperties("Initiative") = objItem.Categories
'objItem.UserProperties("Request Description") =
objItem.BillingInformation
'objItem.UserProperties("Action Notes") = objItem.Mileage
objItem.UserProperties("Task Notes") = objItem.Contacts


'objItem.UserProperties("Custom2") = objItem.User2
'objItem.UserProperties("Custom3") = objItem.User3
'objItem.UserProperties("Custom4") = objItem.User4
'objItem.Categories = ""
'objItem.Role = ""
'objItem.Mileage = ""
'objItem.BillingInformation = ""
'objItem.User2 = ""
'objItem.User3 = ""
'objItem.User4 = ""
objItem.Save
End If
Next
End If

Set objItems = Nothing
Set objItem = Nothing
Set objFolder = Nothing
Set objNS = Nothing
Set objApp = Nothing
End Sub