Hi folks!
The following code was put in a self-signed macro two months ago and was working like a charm, but now it doesn't work any more. Any ideas why?
This macro converts incoming mail to a task and then moves them to a SharePoint-list. What happends is that it doesn't do it automatic anymore, but if I run the macro manually it still works. What may cause this?
Sub ConvertMailtoTask(Item As Outlook.MailItem)
Dim objTask As Outlook.TaskItem
Set objTask = Application.CreateItem(olTaskItem)
'move this up here just to get it out of the way
Set SPSFolder = GetFolderPath("SharePoint-lists\Archiving - Archiving registry")
' this creates and saves the task
With objTask
.Subject = Item.Subject
.StartDate = Item.ReceivedTime
.Body = Item.Body
.Save
End With
' this can go right before 'end with' (if so remove ojbtask from it)
objTask.Move SPSFolder
' this goes last, before the sub ends
Set objTask = Nothing
End Sub
Function GetFolderPath(ByVal FolderPath As String) As Outlook.Folder
Dim oFolder As Outlook.Folder
Dim FoldersArray As Variant
Dim i As Integer
On Error GoTo GetFolderPath_Error
If Left(FolderPath, 2) = "\\" Then
FolderPath = Right(FolderPath, Len(FolderPath) - 2)
End If
'Convert folderpath to array
FoldersArray = Split(FolderPath, "\")
Set oFolder = Application.Session.Folders.Item(FoldersArray(0))
If Not oFolder Is Nothing Then
For i = 1 To UBound(FoldersArray, 1)
Dim SubFolders As Outlook.Folders
Set SubFolders = oFolder.Folders
Set oFolder = SubFolders.Item(FoldersArray(i))
If oFolder Is Nothing Then
Set GetFolderPath = Nothing
End If
Next
End If
'Return the oFolder
Set GetFolderPath = oFolder
Exit Function
GetFolderPath_Error:
Set GetFolderPath = Nothing
Exit Function
End Function
Many thanks for your help
/Paul
The following code was put in a self-signed macro two months ago and was working like a charm, but now it doesn't work any more. Any ideas why?
This macro converts incoming mail to a task and then moves them to a SharePoint-list. What happends is that it doesn't do it automatic anymore, but if I run the macro manually it still works. What may cause this?
Sub ConvertMailtoTask(Item As Outlook.MailItem)
Dim objTask As Outlook.TaskItem
Set objTask = Application.CreateItem(olTaskItem)
'move this up here just to get it out of the way
Set SPSFolder = GetFolderPath("SharePoint-lists\Archiving - Archiving registry")
' this creates and saves the task
With objTask
.Subject = Item.Subject
.StartDate = Item.ReceivedTime
.Body = Item.Body
.Save
End With
' this can go right before 'end with' (if so remove ojbtask from it)
objTask.Move SPSFolder
' this goes last, before the sub ends
Set objTask = Nothing
End Sub
Function GetFolderPath(ByVal FolderPath As String) As Outlook.Folder
Dim oFolder As Outlook.Folder
Dim FoldersArray As Variant
Dim i As Integer
On Error GoTo GetFolderPath_Error
If Left(FolderPath, 2) = "\\" Then
FolderPath = Right(FolderPath, Len(FolderPath) - 2)
End If
'Convert folderpath to array
FoldersArray = Split(FolderPath, "\")
Set oFolder = Application.Session.Folders.Item(FoldersArray(0))
If Not oFolder Is Nothing Then
For i = 1 To UBound(FoldersArray, 1)
Dim SubFolders As Outlook.Folders
Set SubFolders = oFolder.Folders
Set oFolder = SubFolders.Item(FoldersArray(i))
If oFolder Is Nothing Then
Set GetFolderPath = Nothing
End If
Next
End If
'Return the oFolder
Set GetFolderPath = oFolder
Exit Function
GetFolderPath_Error:
Set GetFolderPath = Nothing
Exit Function
End Function
Many thanks for your help
/Paul