Question

我需要提取Outlook电子邮件并将其命名为发件人电子邮件地址的一部分（在＆＃34; @＆＃34;之后＆＃34; .com＆＃34;）。我的代码工作正常，但对于重命名部分，某些文件未正确分配，尤其是线程中的电子邮件。我曾尝试寻找过去两周的解决方案，但未能这样做。如果有人能帮我解决这个问题，我将不胜感激。谢谢！

[增订]：在一个帖子中：它是从原始电子邮件开始的所有后续回复的运行列表。

我已编写代码将电子邮件提取到指定位置，在提取后，该电子邮件应命名为＆＃34;公司的name_datetime received_title of email＆＃34;。用户名假设从发件人电子邮件地址中提取。例如，如果我收到来自john@companyA.com的电子邮件，则主题标题为＆＃34; project＆＃34; ，当我运行提取时，重命名方式应为＆＃34;公司A_12-08-2017 09:30 AM_Project＆＃34;。

但是，使用此当前代码，某些电子邮件将以不同的公司名称命名，尤其是线程中的电子邮件。例如，john@companyA.com会发送一封标题为＆＃34; Project＆＃34;我（cheese@companyB.com）回复了，标题现在变为＆＃34; RE：Project＆＃34;。当我运行提取时，电子邮件的电子邮件重命名方式＆＃34;项目＆＃34;是正确的，而对于电子邮件＆＃34; RE：Project＆＃34;，重命名结果结果是＆＃34; companyC_datetime received_RE：Project＆＃34;公司C甚至不存在于该电子邮件中。（公司C来自其他电子邮件）。

    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用于预期错误。

我建议有一个意想不到的错误，可能是因为MItem对象不是mailitem。

如果是这样，这条线就会失败。

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

现在由于滥用On Error Resume Next，您没有机会修复错误。 strEmail仍然是错误之前的版本。

Dim MItem as object
If MItem.class = olMail then

提取/分配错误的发件人电子邮件地址

1 个答案: