import outlook task to excel
 

This work on my machine, win xp with office xp. Anyone who see why it's not
working when i email it to a win98 machine, and runs it?

Dim olApp As Outlook.Application
Dim olNSpace As Outlook.NameSpace
Dim oltaskFolder As Outlook.MAPIFolder
Dim oltaskItem As Outlook.TaskItem
Dim wbBbok As Workbook
Dim wsSheet As Worksheet
Dim lnCount As Long, i As Long

Set olApp = CreateObject("Outlook.Application")
Set olNSpace = olApp.GetNamespace("MAPI")
Set oltaskFolder = olNSpace.GetDefaultFolder(olFolderTasks)

lnCount = oltaskFolder.Items.Count

If lnCount = 0 Then
MsgBox "Nothing to import", vbInformation
GoTo ErrorHandlerExit
End If

Set wbBbok = Application.ActiveWorkbook
Set wsSheet = wbBbok.Sheets("taskimport")

'Slett gamle data
With wsSheet
.Range("A2").CurrentRegion.ClearContents
.Range("A1:d1").Value = VBA.Array("task", "Tekst", "Alarm", "Status")
End With


i = 1
For Each oltaskItem In oltaskFolder.Items
i = i + 1

With wsSheet
.Cells(i, 2).Value = oltaskItem.Subject
.Cells(i, 4).Value = oltaskItem.Body
.Cells(i, 5).Value = oltaskItem.ReminderSet
.Cells(i, 6).Value = oltaskItem.Status
.Cells(i, 1).Value = oltaskItem.StartDate
End With

Next oltaskItem

With wsSheet
.Columns("A:K").EntireColumn.AutoFit
End With

ErrorHandlerExit:
Set oltaskItem = Nothing
Set oltaskFolder = Nothing
Set olNSpace = Nothing
Set olApp = Nothing
Exit Sub

ErrorHandler:
If Err.Number = 429 Then
Set olApp = CreateObject("Outlook.Application")
Resume Next
Else
MsgBox "Error No.: " & Err.Number & _
"; Description: " & Err.Description
End If
Resume ErrorHandlerExit
End Sub

import outlook task to excel
 

stabekk

What about it doesn't work? Are you getting a specific error message?
Which version of Office is the Win98 machine running?

--
Dick Kusleika
MVP - Excel
www.dicks-clicks.com
Post all replies to the newsgroup.

"stabekk" wrote in message
...
This work on my machine, win xp with office xp. Anyone who see why it's
not
working when i email it to a win98 machine, and runs it?

Dim olApp As Outlook.Application
Dim olNSpace As Outlook.NameSpace
Dim oltaskFolder As Outlook.MAPIFolder
Dim oltaskItem As Outlook.TaskItem
Dim wbBbok As Workbook
Dim wsSheet As Worksheet
Dim lnCount As Long, i As Long

Set olApp = CreateObject("Outlook.Application")
Set olNSpace = olApp.GetNamespace("MAPI")
Set oltaskFolder = olNSpace.GetDefaultFolder(olFolderTasks)

lnCount = oltaskFolder.Items.Count

If lnCount = 0 Then
MsgBox "Nothing to import", vbInformation
GoTo ErrorHandlerExit
End If

Set wbBbok = Application.ActiveWorkbook
Set wsSheet = wbBbok.Sheets("taskimport")

'Slett gamle data
With wsSheet
.Range("A2").CurrentRegion.ClearContents
.Range("A1:d1").Value = VBA.Array("task", "Tekst", "Alarm", "Status")
End With


i = 1
For Each oltaskItem In oltaskFolder.Items
i = i + 1

With wsSheet
.Cells(i, 2).Value = oltaskItem.Subject
.Cells(i, 4).Value = oltaskItem.Body
.Cells(i, 5).Value = oltaskItem.ReminderSet
.Cells(i, 6).Value = oltaskItem.Status
.Cells(i, 1).Value = oltaskItem.StartDate
End With

Next oltaskItem

With wsSheet
.Columns("A:K").EntireColumn.AutoFit
End With

ErrorHandlerExit:
Set oltaskItem = Nothing
Set oltaskFolder = Nothing
Set olNSpace = Nothing
Set olApp = Nothing
Exit Sub

ErrorHandler:
If Err.Number = 429 Then
Set olApp = CreateObject("Outlook.Application")
Resume Next
Else
MsgBox "Error No.: " & Err.Number & _
"; Description: " & Err.Description
End If
Resume ErrorHandlerExit
End Sub