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

我需要提取Outlook电子邮件并将其用发件人电子邮件地址的一部分（在“@”之后和“.com”之前）命名。我的代码工作正常，但对于重命名部分，一些文件没有正确分配，尤其是线程内的电子邮件。过去两周我曾尝试寻找解决方案，但未能如愿。希望有人能帮我解决这个问题。谢谢！提取/分配错误的发件人电子邮件地址

[已更新]：在一个线程内：它是从原始电子邮件开始的所有后续回复的运行列表。

我已经编写了代码将电子邮件提取到指定位置，并且在提取后，该电子邮件应该被命名为“公司的名称_日期时间received_title电子邮件”。用户名假设从发件人电子邮件地址中提取。例如，如果我收到来自[email protected]的电子邮件，主题标题为“项目”，当我运行提取时，重命名方式应为“公司A_12-08-2017 09:30 AM_Project”。

但是，使用这个当前的代码，一些电子邮件将被命名为不同的公司名称，特别是线程中的电子邮件。例如，[email protected]发送标题为“项目”的电子邮件，我（[email protected]）回复，标题现在变成“RE：Project”。当我运行提取时，电子邮件“项目”的电子邮件重命名方式是正确的，而对于电子邮件“RE：Project”，重命名结果竟然是“companyC_datetime received_RE：Project”，公司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

来源

2017-09-04 Cheese

请编辑问题，并写下你过去两周试过的东西。同时解释你的意思是“在一个线程内”。请提供所需输入和匹配输出的例子。最后，请阅读：https://stackoverflow.com/help/mcve –

@MaciejJureczko我上面编辑了我的问题。谢谢！ – Cheese

On Error Resume Next是针对预期的错误。

我建议有一个意外的错误，可能当MItem对象不是mailitem。

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

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

现在由于误操作错误继续下一步，您没有机会修复错误。 strEmail仍然是错误发生之前的状态。

Dim MItem as object 
If MItem.class = olMail then

来源

2017-09-04 17:55:31 niton

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

回答

相关问题