day*_*yao 6 email excel outlook vba
我正在尝试从每个无法送达的电子邮件正文中提取电子邮件地址。
\n电子邮件正文如下：
\n\n\n- - - - - - - - - - - - - - 电子邮件 - - - - - - - - - - - --------
\n
\n\n无法发送至对方或群组：
\n
\n\nXXXX@XXXXXX.XXX (XXXX@XXXXXX.XXX)
\n
\n\n...不需要信息...
\n
\n\n至：XXXX@XXXXXX.XXX
\n
\n\n...不需要信息...
\n
\n\n- - - - - - - - - - - - - - 电子邮件 - - - - - - - - - - - --------
\n
我想出了下面的代码：
\nSub Test()\n Dim myFolder As MAPIFolder\n Dim Item As Outlook.MailItem 'MailItem\n Dim xlApp As Object 'Excel.Application\n Dim xlWB As Object 'Excel.Workbook\n Dim xlSheet As Object 'Excel.Worksheet\n Dim Lines() As String\n Dim i As Integer, x As Integer, P As Integer\n Dim myItem As Variant\n Dim subjectOfEmail As String\n Dim bodyOfEmail As String\n\n'Try access to excel\n On Error Resume Next\n Set xlApp = GetObject(, "Excel.Application")\n If xlApp Is Nothing Then\n Set xlApp = CreateObject("Excel.Application")\n xlApp.Application.Visible = True\n If xlApp Is Nothing Then\n MsgBox "Excel is not accessable"\n Exit Sub\n End If\n End If\n On Error GoTo 0\n\n 'Add a new workbook\n Set xlWB = xlApp.Workbooks.Add\n xlApp.Application.Visible = True\n Set xlSheet = xlWB.ActiveSheet\n Set myFolder = GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)\n For Each myItem In myFolder.Items\n subjectOfEmail = myItem.Subject\n bodyOfEmail = myItem.Body\n\n 'Search for Undeliverable email\n If bodyOfEmail Like "*Delivery*" & "*failed*" And indexOfEmail Like "*Undeliverable*" Then\n x = x + 1\n 'Extract email address from email body\n Lines = Split(myItem.Body, vbCrLf)\n For i = 0 To UBound(Lines)\n P = InStr(1, Lines(i), "@", vbTextCompare)\n Q = InStr(1, Lines(i), "(", vbTextCompare)\n If P > 0 Then\n xlApp.Range("A" & x) = Trim$(Mid$(Lines(i), 1, Q - 1)) 'extract the email address\n Exit For\n End If\n Next\n End If\n Next\nEnd Sub\n它适用于我的测试电子邮件收件箱，它打开一个 Excel 工作表并列出目标电子邮件中的每个特定电子邮件地址。
\n当我在我的工作电子邮件帐户上运行此代码时，它没有给我任何东西。我发现它在阅读“无法投递”电子邮件时遇到问题，并且每次运行后，其中一封无法投递的电子邮件都会变成无法阅读的繁体中文字符。
\n\n\n\xe6\xa0\xbc\xe6\xb5\xb4\xe3\xb9\xac\xe6\xa0\xbc\xe6\x85\xa5\xe3\xb9\xa4\xe0\xa8\x8d\xe6\xb4\xbc\xe7 \x91\xa5\xe2\x81\xa1\xe7\x91\xa8\xe7\x81\xb4\xe6\x94\xad\xe7\x95\xb1\xe7\x99\xa9\xe2\x88\xbd\xe6\xbd \x83\xe7\x91\xae\xe6\xb9\xa5\xe2\xb5\xb4\xe7\xa5\x94\xe6\x95\xb0\xe2\x80\xa2\xe6\xbd\xa3\xe7\x91\xae \xe6\xb9\xa5\xe3\xb5\xb4\xe7\x90\xa2\xe7\xa1\xa5\xe2\xbd\xb4\xe7\x91\xa8\xe6\xb1\xad\xe2\x80\xbb\xe6 \xa1\xa3\xe7\x89\xa1\xe6\x95\xb3\xe3\xb5\xb4\xe7\x8d\xb5\xe6\x84\xad\xe6\x8d\xb3\xe6\xa5\xa9\xe3\xb8 \xa2\xe2\xbc\xbc\xe6\x95\xa8\xe6\x91\xa1\xe3\xb0\xbe\xe6\xbd\xa2\xe7\xa5\xa4\xe0\xb4\xbe\xe3\xb0\x8a \xe3\xb9\xb0\xe6\x88\xbc\xe3\xb0\xbe\xe6\xbd\xa6\xe7\x91\xae\xe6\x8c\xa0\xe6\xb1\xaf\xe7\x89\xaf\xe2 \x88\xbd\xe3\x80\xa3\xe3\x80\xb0\xe3\x98\xb0\xe2\x88\xb6\xe7\x8c\xa0\xe7\xa9\xa9\xe3\xb5\xa5\xe3\x8c \xa2\xe2\x80\xa2\xe6\x85\xa6\xe6\x95\xa3\xe2\x88\xbd\xe7\x89\x81\xe6\x85\xa9\xe2\x89\xac\xe4\x90\xbe \xe6\xb1\xa5\xe7\x99\xa9\xe7\x89\xa5\xe2\x81\xb9\xe6\x85\xa8\xe2\x81\xb3\xe6\x85\xa6\xe6\xb1\xa9\xe6 \x91\xa5\xe7\x90\xa0\xe2\x81\xaf\xe6\xa1\xb4\xe7\x8d\xa5\xe2\x81\xa5\xe6\x95\xb2\xe6\xa5\xa3\xe6\xa5 \xb0\xe6\xb9\xa5\xe7\x8d\xb4\xe6\xbc\xa0\xe2\x81\xb2\xe7\x89\xa7\xe7\x95\xaf\xe7\x8d\xb0\xe3\xb0\xba \xe6\x98\xaf\xe6\xb9\xaf\xe3\xb9\xb4\xe2\xbc\xbc\xe3\xb9\xa2\xe2\xbc\xbc\xe3\xb9\xb0\xe0\xa8\x8d\xe6 \x98\xbc\xe6\xb9\xaf\xe2\x81\xb4\xe6\xbd\xa3\xe6\xbd\xac
\n
我觉得此代码仅适用于我的测试电子邮件收件箱中转发的无法送达的电子邮件。
\n它从未读取原始无法投递的电子邮件，并将这些电子邮件一封一封地转换为汉字。
我用谷歌搜索了一下，看来 Outlook 中存在发送失败电子邮件的错误。如何解决这个问题？
\n经过几天的沮丧，我终于想出了一个更简单的解决方案，不需要担心 Outlook 中 NDR 的任何限制，甚至根本不用 VBA...
我所做的是：
不敢相信这比 VBA 简单得多......
谢谢你们的帮助！只是无法真正处理“Outlook NDR 变成不可读字符”的错误，并且对工作站有如此多的限制，认为这可能会有所帮助！