Extracting/Assigning wrong sender email address

Question

I need to extract outlook emails and name it with part of the sender email address (after "@" and before ".com"). My codes works fine but as for the renaming part, some of the files are not assigned correctly, especially emails within a thread. I had tried searching for solutions for the past 2 weeks, but failed to do so. Would appreciate if anyone could help me out on this issue. Thanks!

[UPDATED]: Within a thread: It's the running list of all the succeeding replies starting with the original email.

I've wrote codes to extract emails into a designated location and after it is extracted, that email should be named "company's name_datetime received_title of email". Username Suppose to be extracted from sender email address. For example, if I received email from [email protected], subject header is "project" , when I run extraction, the renaming way should be "company A_12-08-2017 09:30AM_Project".

However, with this current code, some of the emails will be named with different company name especially emails in thread. For example, [email protected] send an email with title "Project" and I ([email protected]) replied back and title now becomes "RE:Project". When I run extraction, the email renaming way for the email "Project" is correct, whereas for email "RE:Project", the renaming outcome turns out to be "companyC_datetime received_RE:Project" where Company C does not even exist in that email. (Company C comes from other emails).

    Set SubFolder = OutlookApp.Session.GetFolderFromID(EntryID(i), StoreID(i))
    On Error Resume Next
    For j = 1 To SubFolder.Items.Count
        Set MItem = SubFolder.Items(j)
        strEmail = Split(SubFolder.Items(j).SenderEmailAddress, "@")(1)
        If (InStr(1, strEmail, ".") > 0) Then
            strFullName = Split(strEmail, ".")(0)
        End If
        StrReceived = Format(MItem.ReceivedTime, "dd-mm-yyyy H.MMAMPM")
        strSubject = MItem.Subject
        'Rename file as Bank name_Date_Title
        StrName = StripIllegalChar(strSubject)
        StrFile = StrSaveFolder & strFullName & "_" & StrReceived & "_" & StrName & ".msg"
        StrFile = Left(StrFile, 256)
        MItem.SaveAs StrFile, 3
    Next j
    On Error GoTo 0
 Next i

Answer 1

On Error Resume Next is for expected errors.

I suggest there is an unexpected error, likely when the MItem object is not a mailitem.

If so this line would fail.

strEmail = Split(SubFolder.Items(j).SenderEmailAddress, "@")(1)

Now due to the misuse of On Error Resume Next, you do not have a chance to fix errors. strEmail remains what it was before the error.

Dim MItem as object
If MItem.class = olMail then