Outlook-Excel VBA 宏 IF NOT 语句

Question

背景：每天我们都会收到大量包含备份报告的电子邮件，我们目前手动计算它们并找出缺少的内容。

我发现了大量代码（使用 Visual Basic for Applications 运行），它们可以将电子邮件从 Outlook 中提取出来并放入 Excel 中。

现在我只需要删除成功的邮件，这样就可以保留主题行中没有“结果：好的”的电子邮件。

 Public Sub CopyMailtoExcel()

    Dim objOL As Outlook.Application
    Dim objFolder As Outlook.Folder
    Dim objItems As Outlook.Items
    Dim olItem As Object ' MailItem
    Dim strDisplayName, strAttCount, strBody, strDeleted As String
    Dim strReceived As Date
    Dim rCount As Long

'  On Error GoTo Err_Execute
    Application.ScreenUpdating = False

'Find the next empty line of the worksheet
rCount = Range("A" & Rows.Count).End(-4162).Row
rCount = rCount + 1

Set objOL = Outlook.Application

' copy mail to excel
Set objFolder = objOL.ActiveExplorer.CurrentFolder
Set objItems = objFolder.Items

For Each olItem In objItems
strAttCount = ""
strBody = ""

If olItem.Attachments.Count > 0 Then strAttCount = "Yes"

'On Error Resume Next
 'collect the fields
strBody = olItem.Body

' Remove this block if you don't want to remove the hyperlinked urls
Dim Reg1 As RegExp
Dim Match, Matches
Set Reg1 = New RegExp

' remove hyperlinks from bodies for easier reading.
With Reg1
        .Pattern = "<[src|http|mailto](.*)>(\s)*"
        .Global = True
        .IgnoreCase = True

.MultiLine = True

End With

If Reg1.Test(strBody) Then
 strBody = Reg1.Replace(strBody, "")
End If
' end remove hyperlinks block


strBody = Trim(strBody)
strReceived = olItem.ReceivedTime
strSender = olItem.SenderName

' column / field
' A Date
' B Time
' C Attachments (Yes)
' D Subject
' E Body
' F From (display name)
' G To (display name)
' H CC (display name)
' I BCC (sent items only)

'write them in the excel sheet
 Range("A" & rCount) = strReceived ' format using short date
 Range("B" & rCount) = strReceived 'format using time
 Range("C" & rCount) = strAttCount
 Range("D" & rCount) = olItem.Subject
 Range("E" & rCount) = strBody
 Range("F" & rCount) = strSender
 Range("G" & rCount) = olItem.To
 Range("H" & rCount) = olItem.CC
 Range("I" & rCount) = olItem.BCC


'Next row
  rCount = rCount + 1
  Next


' Basic Formatting
Columns("A:I").Select
With Selection
    .WrapText = True
    .HorizontalAlignment = xlGeneral
    .VerticalAlignment = xlTop
    .Columns.AutoFit
End With
Columns("E:E").Select ' body column
With Selection
    .ColumnWidth = 150
    .Rows.AutoFit
End With

Range("A1:I1").Select
 With Selection
        .VerticalAlignment = xlBottom
        .WrapText = False
        .RowHeight = 55
End With


' Date and Time
Columns("A:A").Select
Selection.NumberFormat = "[$-409]ddd mm/dd/yy;@"
Range("B:B").Select
Selection.NumberFormat = "[$-F400]h:mm AM/PM"

Range("D:D").Select
Selection.ColumnWidth = 20


Range("A2").Select

Application.ScreenUpdating = True
Set olItem = Nothing
Set objFolder = Nothing
Set objOL = Nothing
Set Reg1 = Nothing

MsgBox "Email import complete"

Exit Sub

Err_Execute:
    MsgBox "An error occurred."

End Sub

以下是成功和无效备份报告电子邮件主题行的示例。每个工作的配置文件名称都不同，因此会发生变化。 成功：

ViceVersa Notification. Profile: R4Data_D - Result: OK.  

Failure  
ViceVersa Notification. Profile: ST29 Data - Result: Source folder not found.

失败的并不总是像上面那样，因为它们因不同的原因而失败，所以我想我需要一个 IF 或 IF NOT 语句来做这样的事情：

如果主题行包含“结果：OK”以外的任何内容。那就不要导出

但我知道它需要允许不同的配置文件名称等。

另一种选择是读出电子邮件正文，在这种情况下，我希望宏仅提取电子邮件正文中没有“退出代码：0”的电子邮件。

抱歉，我不知道如何构建它！

感谢原Original CodeDiane Poremsky

Answer 1

您应该能够使用以下测试：

If InStr(olItem.Subject, "Result: OK") = 0