S
stabekk
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
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