Email to task without changin formatting

[LaoFly]

Hello Slipstick forum!

I got a little macro running which turns specific mails into tasks basically working as a tiny supportsystem for me to keep track of stuff at my company.
The thing is that it won't keep the formatting. I tried 3 way to do this:

Right now I just use

newTask.Attachments.Add NewItem

but I don't really like it that way as it's a mail in a task.

The second one is the 'open in word, copy, paste' method.

    Set objDoc = sourceItem.GetInspector.WordEditor
    If Not objDoc Is Nothing Then
        Set objSel = objDoc.Windows(1).Selection
        objSel.WholeStory
        objSel.Copy
        Set objDoc2 = targetItem.GetInspector.WordEditor
        If Not objDoc2 Is Nothing Then
            Set objSel2 = objDoc2.Windows(1).Selection
            objSel2.PasteAndFormat wdPasteDefault
        End If
    End If
newTask.Display

this one looks lovely, but keeps crashing every once in a while.

And simply using

 newTask.Body = NewItem.Body

resulsts in missing images, double spacing (which I have taken care of), and just odd formatting in general.

Is there any other way, or maybe some ideas to fix the crashes ?

Outlook 2010 H&B running on Server 2012R2.


If needed, I will provide further details and information.

Best wishes and thanks in advance,
Chris

 

[Diane Poremsky]

Part of the problem is that tasks doesn't support HTML, so you can't use HTML body. I haven't tried converting the message body to RTF then pasting... not sure it will work. (MailItem.RTFBody Property (Outlook) I haven't had crash problems with the word paste method - but it could be something different between 2016 and 2010.

So basically... you are stuck unless RTF body works better than using word.

 

[LaoFly]

I tried experimenting with RTF/HTML convertion, no luck with that.
But I'll give it another shot tomorrow.

Yeah it's kinda weird. Most of the time it works just fine, then all of a sudden it crashes and disables the rules. I created a rule to check if the other rule is active, if not, activate, but when it crashes both rules are disabled. So I would need a rule to check the rule to check the rule.

I guess I'll look into it again toomorrow maybe I'll get it to work without crashing.


Oh by the way, I read many of your posts about VBA thank you really much, I appreaciate your work!
Got some pretty neat things to work because of you!

Im gonna check back tomorrow with some updates.


With kind regards,
Chris

 

[Diane Poremsky]

Heh... it works here. I changed the macro i use to use RTF - in my case, i save the new tasks to one of two folders and use a stub macro to set the folder (and the GetCurrentItem function so it works for open or selected messages) - the task looks nice - downloaded images won't copy (even if i download the blocked content first), embedded images are not kept. Using .Body = objMail.RTFBody won't keep them either.

This screenshot is of the original message (the pink formatting was another macro test for someone last week ) - using word to paste is in the middle and using RTF is on the right. Word gets external content.



This message has 3 images inserted - RTF drops them but my macro adds them as attachments.

Sub TaskRTF()
Dim Ns As Outlook.NameSpace
Set Ns = Application.GetNamespace("MAPI")
Set tasksFolder = Ns.GetDefaultFolder(olFolderTasks)
ConvertRTFToTask
End Sub


Private Sub ConvertRTFToTask()
    Dim objTask As Outlook.TaskItem
    Dim objMail As Outlook.MailItem
   
    On Error Resume Next
   Set objMail = GetCurrentItem()
   Set objTask = tasksFolder.Items.Add(olTaskItem)
 
   strRTF = StrConv(objMail.RTFBody, vbUnicode)

Debug.Print strRTF
 
With objTask
If objMail.Attachments.Count > 0 Then
     CopyAttachments objMail, objTask
End If

    .Subject = objMail.Subject
    .DueDate = Now + 3
    .StartDate = Now + 2
    .ReminderSet = True
    .ReminderTime = .DueDate + "2:00:00 PM"
    .Body = strRTF
   ' .Save
    .Display
End With

    Set objTask = Nothing
    Set objMail = Nothing
End Sub

 

[LaoFly]

Yeah when I first tried to do it, I just copied the body, removed the double spaces and reattached all images. The thing is, when someone get a mail marked as spam by our firewall, they get a mail, forward it to support and we check it and release or block it.

But the mail contains a huge amount of images. If I remove those the mail becomes cryptic and you need to take a close look just to get the information you need.

I had a workaround of not taking those mails a tasks and just forward them but well. It would be really nice if I could just get it to work properly somehow without changing the body or it's contents in any way.

Guess I won't get around the word method.


Thanks again.

 

[Diane Poremsky]

BTW, the macro i use to copy using word and insert into tasks is here - Create Task or Appointment and Insert Selected Text - our codes are slightly different but i have no idea if mine might work better than yours.

to use it in a rule, remove the set objmail line and change the top lines:
Sub ConvertSelectionToTask(objMail As Outlook.MailItem)

Dim objTask As Outlook.TaskItem


one other thought - if you are getting multiple messages in at once that trigger the rule, this could cause failure because the macro is busy - use the stub method - the rule grabs the message and hands it off to the macro so the rule is ready to process the next one. This is especially helpful when you do stuff that can take longer to process.

Sub TaskRTF(objMail As Outlook.MailItem)
ConvertRTFToTask objMail
End Sub

private Sub ConvertRTFToTask (objMail As Outlook.MailItem)

 

[Diane Poremsky]

one other thought - itemadd instead of rules - you'll need something to use an if statement on -
if sender = quarantine address should work.

ETA: you could use rules to move the messages to a folder, then use itemadd to watch the folder and process the mail. If you do this, i'd mark the mail read after it's processed so you know if the macro fails.

 

[LaoFly]

Heya Diane,

sorry for the late feedback. I changed it so the mail is an attachment in the task. It is the safest way to keep it running imo.

And still it crashes after a while. The whole thing runs on a Server 2012 at the moment, the user is not logged off but locked. It runs for a while and after a while the rule crashes. So I'll just post the whole code for it here maybe you can see something that causes problems.

I edited out some parts as for sensitive information.
The code is really messy since I changed large chunks of it and didn't have the time to clean it up just yet.
There was, well, still is a function to check if certain computers are online to send them a mail to notify them about the incoming ticket, if they're offline, don't send notification. But that function just wasn't necessary so I hid it.

Again, it works fine for a while and then the rule just crashes after a bit.
I used a second rule to check if the first rule is active everytime a mail comes in, but if the first rule crashes the second one does too.

Well maybe you, or someone else finds something that I just don't see or don't know.

Many thanks in advance!

Sub ChangeSubjectForward(NewItem As Outlook.MailItem)

    On Error Resume Next

'Global Items
IncSubject = NewItem.Subject
Sender = NewItem.Sender
Dim newTask As Outlook.TaskItem
'Dim WordApp As Word.Application
'Dim wdDoc As Word.Document
Set newTask = Application.CreateItem(olTaskItem)

'logs
Dim rStats As String: rStats = Now & "--- INCOMING TICKET '" & IncSubject & "' FROM " & Sender
strFile_path = "C:\Tickets\logs\logs.txt"
Open strFile_path For Append As #1
Write #1, rStats
Close #1

'get ticket ID, +1, write new ID
Dim path As String: path = "C:\Tickets\config\lidn.txt"
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set file = fso.OpenTextFile(path, 1)
        filereader = file.ReadLine
        NewNumber = CInt(filereader)
             NewNumber = NewNumber + 1
                fso.CreateTextFile(path, True).Write (NewNumber)

    newTask.Attachments.Add NewItem
  
With newTask
    .DueDate = Now
    .Subject = "Ticket#" & NewNumber & " - " & Sender & " - " & Now & " - " & " ' " & IncSubject & " ' "
    .Save
End With

'Save task in right folder
Set olNS = NewItem.Application.GetNamespace("MAPI")
Set accs = olNS.Accounts
For Each Account In accs
    If Account.AccountType = olExchange And Account.SmtpAddress = olNS.Session.DefaultStore Then
        Set pub = olNS.Folders("Public Folders" & " - " & Account.SmtpAddress).Folders("All Public Folders").Folders("Support").Folders("Tickets")
    End If
Next

Dim outObj As Outlook.Application
Dim objFolder As Outlook.MAPIFolder

Set outObj = CreateObject("outlook.application")
Set objFolder = pub
newTask.Move objFolder

With NewItem
    .Subject = Sender & " sent new support request titled: '" & IncSubject & "' at " & Now
    .Save
End With

Set Forward = NewItem.Forward
Forward.Recipients.Add me@test.com

rStats = Now & "--- SUCCESFULLY RECEIVED AND CONVERTED TICKET" & vbNewLine
strFile_path = "C:\Tickets\logs\logs.txt"
Open strFile_path For Append As #1
Write #1, rStats
Close #1
   
End Sub

 

[Diane Poremsky]

Again, it works fine for a while and then the rule just crashes after a bit.

i wonder if it's a memory issue - since you declare the variables in the macro - set them to nothing at the end.
set newTask = nothing
Set outObj = nothing ' are you even using this variable?
Set objFolder = nothing

Does this work?
Set olNS = NewItem.Application.GetNamespace("MAPI")
Set accs = olNS.Accounts

Have you tried removing on error resume next and seeing if it hangs?

If any of the variables are used every time, it might be better to set them globally at startup - you'd definitely need to restart outlook after the rules crash though as that will kill the variable.

 

[LaoFly]

Thanks for the reply.

Do the variables persist even when the macro is done?
If so a memory issue could be the case. Didn't think of that.

I put the = nothing statement at the end of the code, let's see if it changes anything.
And yeah I use the outObj but just once to move the task to the folder.

I just replaced the on error resume next with a on error goto errorhandler I used in another macro which comes in handy but I didn't think about using it here for some reason.

ErrorHandler:
  If Err.Number <> 0 Then
     msg = "Error# " & Str(Err.Number) & " generated by " _
         & Err.Source & Chr(13) & "Line: " & Erl & Chr(13) & Err.Description
    
     rStats = Now & " - ERROR - " & msg
        strFile_path = "C:\Tickets\logs\logs.txt"
        Open strFile_path For Append As #1
        Write #1, rStats
        Close #1
            Resume Next
     End If

This should give me at least a proper error log.

And I already set up a task schedule to restart outlook twice a day - just to make sure.


I'll test it with the nothing statements and check back once I got some results.

Thanks again.

cheers
Chris

 

[LaoFly]

Oooooh and I just realized what you mean.

Dim outObj As Outlook.Application
Dim objFolder As Outlook.MAPIFolder

Set outObj = CreateObject("outlook.application")
Set objFolder = pub
newTask.Move objFolder

I just scrapped that whole part and simply use
newTask.Move pub
Don't know why I didn't do that beforehand

 

[LaoFly]

Okay, so we had a long weekend here and guess what, it crashed. At some point between the 24. and this morning it crashed and deactivated the rules.

And I didnt get any logs about it.

So I assume that it's not the code but Outlook as the code would give me at least some kind of error.

Eventviewer doesn't show anything but "Addins where loaded".


I just tested it and got an "Error running the operation" for both rules.
Logs still won't show anything. So the script doesn't even run.
It just crashes without doing anything. But why?

The rule just says "If receiving mail, run script". Why would it crash before even running the script ?

I'm all out of ideas here.



Kind Regards,
Chris

 

[Diane Poremsky]

Was the logging working before the 24th?

You aren't using 2016 on to run the scripts, correct? They are disabling run a script rules in 2016 - not sure if it will be back ported to earlier versions. Scripts need to be enabled using a reg key. Run-a-Script Rules Missing in Outlook 2016

 

[LaoFly]

If I do an error on purpose it works and logs it.
No logs between 24th and today though.

The Server is 2012 R2 and is running Outlook 2010 H&B.

This is getting more and more frustrating.

I send a test mail every now and then, remote log on the server and there it is the shiny blinking window "The operation failed" and the rules are disabled again after working fine for hours or sometimes even a few days.

No logs though.

 

[Diane Poremsky]

(correction) What is the error handler? I'm wondering if it fails on something and isn't handling the error.

 

[LaoFly]

Pretty much this at the very end of the code:

ErrorHandler:
  If Err.number <> 0 Then
     msg = "Error # " & str(Err.number) & " generated by " _
         & Err.Source & Chr(13) & "Line: " & Erl & Chr(13) & Err.Description
     MsgBox msg, , "Error", Err.HelpFile, Err.HelpContext
   
     Dim rStats As String: rStats = Now & " - ERROR - " & msg
        strFile_path = "C:\Tickets\logs\logs.txt"
        Open strFile_path For Append As #1
        Write #1, rStats
        Close #1
            Resume Next
     End If

But then again if I force an error by for example NewItems.XYZ it gives me a proper log about it.

 

[Diane Poremsky]

Remove MsgBox msg, , "Error", Err.HelpFile, Err.HelpContext - if you aren't in front of the console to dismiss the message box, outlook will basically hang.

resume next in the write routine should push it on without forcing the rule to die - as long as it gets triggered by the code.

Also, use a stub macro to test the code manually on a selected message using the step into command so you can watch it run.

Sub RunScript()
Dim objApp As Outlook.Application
Dim objItem As MailItem
Set objApp = Application
Set objItem = objApp.ActiveExplorer.Selection.Item(1)

'macro name you want to run goes here
OpenLinks objItem

End Sub