We help IT Professionals succeed at work.

Save email copy

Theva
Theva asked
on
Hi Experts,

I need Experts help to troubleshoot the attached script. The script by right should be able to save the sent email into separate network folder. But, for some reason this can’t be achieved.  I hope Experts can help me to rectify this problem. Attached is the mentioned script.



Dim WithEvents olkFolder As Outlook.Items

Private Sub Application_Quit()
    Set olkFolder = Nothing
End Sub

Private Sub Application_Startup()
    Set olkFolder = Session.GetDefaultFolder(olFolderSentMail).Items
End Sub

Private Sub olkFolder_ItemAdd(ByVal Item As Object)
    'Edit the condition on the next line'
    If Left(Item.Subject, 12) = "TK Followup:" Then
        'Edit the folder path on the next line'
        Item.SaveAs "\\bc02\email\Report\" & Item.Subject & ".msg", olMSG
    End If
End Sub

Open in new window

Comment
Watch Question

Top Expert 2011

Commented:
First off is capitalisation of the subject precise?

Chris
Top Expert 2011

Commented:
ALso I presume you have restarted outlook since the code was inserted?

CHris

Author

Commented:
Hi Chris,

I've crosscheck the subject's title, also restarted the outlook but nothing happen.
Top Expert 2011

Commented:
Is the code located in thisOutlookSession?

Author

Commented:
Hi Chris,


The creator of this code has responded with the revised version (attached) and its work. However, this is only save email which has “TK Followup:”. If the user using the same email for reply, then its loosing the  save function. Is that anyway for us to save the  email with reply version if the subject has this title “TK Followup:”? Hope you can assist.

Dim WithEvents olkFolder As Outlook.Items

Private Sub Application_Quit()
    Set olkFolder = Nothing
End Sub

Private Sub Application_Startup()
    Set olkFolder = Session.GetDefaultFolder(olFolderSentMail).Items
End Sub

Private Sub olkFolder_ItemAdd(ByVal Item As Object)
    'Edit the condition on the next line'
    If Left(Item.Subject, 12) = "TK Followup:" Then
        'Edit the folder path on the next line'
        Item.SaveAs "\\So02\report\mail\" & RemoveIllegalCharacters(Item.Subject) & ".msg", olMSG
    End If
End Sub

Function RemoveIllegalCharacters(strValue As String) As String
    ' Purpose: Remove characters that cannot be in a filename from a string.'
    
    RemoveIllegalCharacters = strValue
    RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, "<", "")
    RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, ">", "")
    RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, ":", "")
    RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, Chr(34), "'")
    RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, "/", "")
    RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, "\", "")
    RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, "|", "")
    RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, "?", "")
    RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, "*", "")
End Function

Open in new window

Top Expert 2011
Commented:
The save function applies to the sent mail but whilst a sdent item leaves with a title like:

"TK Followup:"
a reply will have something like
"RE: TK Followup:"

Your language prefix may be different but the as long as it's two characters - and I think they all are the following should work.

Chris
Dim WithEvents olkFolder As Outlook.Items

Private Sub Application_Quit()
    Set olkFolder = Nothing
End Sub

Private Sub Application_Startup()
    Set olkFolder = Session.GetDefaultFolder(olFolderSentMail).Items
End Sub

Private Sub olkFolder_ItemAdd(ByVal Item As Object)
    'Edit the condition on the next line'
    If Left(Item.Subject, 12) = "TK Followup:" or mid(Item.Subject, 5, 12) = "TK Followup:" Then
        'Edit the folder path on the next line'
        Item.SaveAs "\\So02\report\mail\" & RemoveIllegalCharacters(Item.Subject) & ".msg", olMSG
    End If
End Sub

Function RemoveIllegalCharacters(strValue As String) As String
    ' Purpose: Remove characters that cannot be in a filename from a string.'
    
    RemoveIllegalCharacters = strValue
    RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, "<", "")
    RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, ">", "")
    RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, ":", "")
    RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, Chr(34), "'")
    RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, "/", "")
    RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, "\", "")
    RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, "|", "")
    RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, "?", "")
    RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, "*", "")
End Function

Open in new window

Author

Commented:
Hi Chris,

Thanks for the great help. Before I close this Q,  I need your advice how to handle email that were saved in network folder. Sometime we could discuss about one issue with many reply emails (ping pong). Is that anyway for to us automatically grouped the email if we have similar subject matter. If there is, then I will get Experts help.
Top Expert 2011

Commented:
Within my knowledge, it depends on mail clients used, if for example someone in the chain uses (for example) Giggle MAil then no.  If everyone is using outlook, then yes I think so.

Chris

Author

Commented:
Hi Chris,

My team using Outlook. How to put this in question so that Experts know what am looking for. Sorry, I have no clue how to address this.
Top Expert 2011

Commented:
It may be easy!

In teh code you are using try replacing all references to Item.Subject with Item.conversationtopic

Chris

Author

Commented:
Hi,

Have changed, but nothing was copied in the network folder. Attached the modified code for your perusal.

Private Sub olkFolder_ItemAdd(ByVal Item As Object)
    'Edit the condition on the next line'
    If Left(Item.ConversationTopic, 12) = "TK Followup:" Or Mid(Item.Subject, 5, 12) = "TK Followup:" Then
        'Edit the folder path on the next line'
        Item.SaveAs "\\bc04\email\Report\" & RemoveIllegalCharacters(Item.ConversationTopic) & ".msg", olMSG
    End If
End Sub

Open in new window

Top Expert 2011
Commented:
If nothing happened at all then :(

One replacement was missed however so ...

Chris
Private Sub olkFolder_ItemAdd(ByVal Item As Object)
    'Edit the condition on the next line'
    If Left(Item.ConversationTopic, 12) = "TK Followup:" Or Mid(Item.ConversationTopic, 5, 12) = "TK Followup:" Then
        'Edit the folder path on the next line'
        Item.SaveAs "\\bc04\email\Report\" & RemoveIllegalCharacters(Item.ConversationTopic) & ".msg", olMSG
    End If
End Sub

Open in new window

Author

Commented:
Hi Chris,

Thanks a lot for helping me to create this feature.