[SOLVED] How to test if the email is a regular email or reply?

How to test if the email is a regular email or reply?

I am writing a script which will automatically save emails to a specified folder based on date. So basically, all of the emails today, will be saved in a folder marked 05/20/2015.

The problem in which I am currently experiencing is that all reply messages are being saved as a file, rather than .msg.

My question is, is there a way to test if the email is a response or a regular email. I figure that I would have been able to do something like this. If Item.Reply Then (code here). Would this be the correct way of doing so, or would I have to go about in testing if the email is a reply is a different way?

Here is the code that I am working with. Here is an example of what I mean. Joe sends me an email. That email gets saved to my specified folder as a .msg. I respond to Joe. Joe responds back. Theoretically the response back from Joe should be saved as .msg, but the message is being saved as .file. That is the part that I do not understanding and I have no idea why this is happening.

    Option Explicit
'// Save the message as a native .msg
Public Sub SaveMesg(Item As Outlook.MailItem)
 Dim fso As FileSystemObject
 Dim olNS As Outlook.NameSpace
 Dim SavePath As String
 Dim TimeDate As Date
 Dim SaveName As String
 Dim Enviro As String
 Dim NewFolder As String
 Dim EmailSubject As String

'// enviro gets the user account part of the path
'// so you can use the same code on different computers
Set olNS = Application.GetNamespace("MAPI")

ReplaceCharsForFileName SaveName, "_"

'// Use My Documents for older Windows.
NewFolder = "C:\ITDocs\" & Format(Now, "YYYY-MM-DD") & "\"

'// Test if directory or file exists
If FileOrDirExists(NewFolder) Then
    MsgBox NewFolder & " exists!"
Else
    MkDir NewFolder
End If

EmailSubject = FileName(Item.Subject)

'// Determine if there is subject
If Item.Subject <> vbNullString Then
    EmailSubject = Item.Subject
Else
    EmailSubject = "No Subject"
End If

'// Determine if the email is a response or not
'// If Item.Reply <> vbNullString Then
   '// EmailSubject = Item.Subject
 '//End If


'// Get Email subject & set name to be saved as
TimeDate = Item.ReceivedTime
SaveName = Format(TimeDate, "YYYYMMDD", vbUseSystemDayOfWeek, _
vbUseSystem) & Format(TimeDate, "-HHNNSS", _
vbUseSystemDayOfWeek, vbUseSystem) & "-" & EmailSubject & SaveName & ".msg"
Set fso = CreateObject("Scripting.FileSystemObject")



'// Save .msg File
SavePath = "C:\IT Documents\" & NewFolder & "\"
Debug.Print NewFolder & SaveName
Item.SaveAs NewFolder & SaveName, olMSG

End Sub

'// This function removes invalid and other characters from file names
Private Sub ReplaceCharsForFileName(SaveName As String, _
 sChr As String _
 )
 SaveName = Replace(SaveName, "/", sChr)
 SaveName = Replace(SaveName, "\", sChr)
 SaveName = Replace(SaveName, ":", sChr)
 SaveName = Replace(SaveName, "?", sChr)
 SaveName = Replace(SaveName, Chr(34), sChr)
 SaveName = Replace(SaveName, "<", sChr)
 SaveName = Replace(SaveName, ">", sChr)
 SaveName = Replace(SaveName, "|", sChr)
 SaveName = Replace(SaveName, "&", sChr)
 SaveName = Replace(SaveName, "%", sChr)
 SaveName = Replace(SaveName, "*", sChr)
 SaveName = Replace(SaveName, " ", sChr)
 SaveName = Replace(SaveName, "{", sChr)
 SaveName = Replace(SaveName, "[", sChr)
 SaveName = Replace(SaveName, "]", sChr)
 SaveName = Replace(SaveName, "}", sChr)
 SaveName = Replace(SaveName, "!", sChr)

End Sub

'// Good practice suggests that it is wise to check before taking certain               actions
'// This function checks if File or Dir Exists
Function FileOrDirExists(PathName As String) As Boolean
Dim iTemp As Integer

 '// Ignore errors to allow for error evaluation
On Error Resume Next
iTemp = GetAttr(PathName)

 '// Check if error exists and set response appropriately
Select Case Err.Number
Case Is = 0
    FileOrDirExists = True
Case Else
    FileOrDirExists = False
End Select

 '// Resume error checking
On Error GoTo 0
End Function

Function FileName(strText As String) As String
 Dim strStripChars As String
 Dim intLen As Integer
 Dim i As Integer
 strStripChars = "/\[]:=," & Chr(34)
    intLen = Len(strStripChars)
 strText = Trim(strText)
    For i = 1 To intLen
 strText = Replace(strText, Mid(strStripChars, i, 1), "")

 Next
 FileName = strText
End Function

Solution

You note that the problem happens when you encounter a message which is either a reply or a forward. One thing both of those have in common is a prefix on the subject, like "RE: something" or "FW: something else". Note the colon in the prefix. I don't see you doing any work to scrub that colon out of the name before calling SaveAs. So you'd be giving SaveAs a pretty odd path with multiple colons in it.

I don't know how SaveAs would react to that, but I'd start there.