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某种类型的声明，这样做是这样的：

如果主题行包含“结果：确定”以外的任何内容。然后不要导出

但我知道需要允许不同的个人资料名称等。

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

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

归功于原始Original Code Diane Poremsky

Answer 1

您应该可以使用以下测试：

dist/

Outlook-Excel VBA宏IF NOT语句

1 个答案: