【发布时间】：2021-01-15 03:25:36
【问题描述】：
我正在尝试遍历 Outlook 中的“已发送”文件夹，并使用电子邮件的“接收时间”更新我的电子表格。
我的电子表格有一列包含记录号。每封电子邮件都包含一个或多个记录号。
如果电子邮件正文有匹配的记录，那么我想提取收到的日期并将其放在一个列中。
我认为问题出在我的 If 语句上。
Option Explicit
Private Sub CommandButton1_Click()
On Error GoTo ErrHandler
' Set Outlook application object.
Dim objOutlook As Object
Set objOutlook = CreateObject("Outlook.Application")
Dim objNSpace As Object ' Create and Set a NameSpace OBJECT.
' The GetNameSpace() method will represent a specified Namespace.
Set objNSpace = objOutlook.GetNamespace("MAPI")
Dim myFolder As Object ' Create a folder object.
Set myFolder = objNSpace.GetDefaultFolder(olFolderSentMail)
Dim objItem As Object
Dim iRows, iCols As Integer
Dim sFilter As String
iRows = 2
Dim MyRange As Range
Dim cell As Range
Dim Wb As Workbook
Dim FiltRange As Range
Workbooks("RIRQ and RRTNs with LOB Sept 28 2020").Activate
'Set MyRange = Workbooks("RIRQ and RRTNs with LOB Sept 28 2020").Worksheets("Data").Range(Cells(1, 1).Offset(1, 0), Range("A1").End(xlDown))
' select the records in column A
Set MyRange = Workbooks("RIRQ and RRTNs with LOB Sept 28 2020").Worksheets("Data").Range(Cells(2, 1), Range("A1").End(xlDown))
'Debug.Print MyRange.Address
'only select the filtered records
Set FiltRange = MyRange.SpecialCells(xlCellTypeVisible)
'Debug.Print FiltRange.Address
'create a filter for emails marked as not completed
sFilter = "[Categories] = 'Not Completed'"
'Debug.Print sFilter
ThisWorkbook.Sheets("Sent_Email").Activate
' Loop through each item in the folder.
'Debug.Print myFolder.Items.Restrict(sFilter).Count
'loop through the emails in the sent folder restricted to specific category
For Each objItem In myFolder.Items.Restrict(sFilter)
If objItem.Class = olMail Then
Dim objMail As Outlook.MailItem
Set objMail = objItem
'extract data from email
Cells(iRows, 1) = objMail.Recipients(1)
Cells(iRows, 2) = objMail.To
Cells(iRows, 3) = objMail.Subject
Cells(iRows, 4) = objMail.ReceivedTime
Cells(iRows, 5) = objMail.Body
'If MyRange <> "" Then
'loop throug the records on the spreadsheet to find matches
For Each cell In FiltRange
'Debug.Print MyRange.Find(cell.Value)
'Debug.Print cell.Value
'Debug.Print Cells(iRows, 5)
'if the email body contain the matching record or specific string then copy the received time to the row for the matching record
If InStr(LCase(Cells(iRows, 5)), cell.Value > 0) And InStr(LCase(Cells(iRows, 5)), LCase("GTPRM")) > 0 Then
enter code here
Debug.Print cell.Value
cell(, 35).Value = Cells(iRows, 4).Value
End If
Next cell
'End If
End If
iRows = iRows + 1
Next
Set objMail = Nothing
' Release.
Set objOutlook = Nothing
Set objNSpace = Nothing
Set myFolder = Nothing
ErrHandler:
Debug.Print Err.Description
End Sub
【问题讨论】：
-
你有什么问题，你的问题是什么？
-
删除
On Error GoTo ErrHandler。该声明说：不要告诉我哪个声明导致了问题；只是放弃宏。在开发过程中，您希望在问题陈述上停止执行。这使得尽可能容易地发现原因。也许你忘了初始化一个对象。如果可能，请确保执行不会失败，并在出现宏无法解决的问题时显示用户友好的消息。您也不希望在操作宏中使用此语句，因为它对用户非常不友好。 -
有时您无法解决问题。例如，如果您要打开一个文件，您可以检查它是否存在，但不能检查您是否拥有必要的访问权限。在这种情况下，您使用：
On Error or Resume NextProblem statementOn Error GoTo 0Check Err.Number。这不是一个完整的解释，但我需要发布一个答案才能给出完整的解释。如果您要求，我会发布答案。 -
嗨托尼，谢谢你的回复，我的问题是我的 if 语句： If InStr(LCase(Cells(iRows, 5)), cell.Value > 0) And InStr(LCase(Cells (iRows, 5)), LCase("GTPRM")) > 0 Then Debug.Print cell.Value cell(, 35).Value = Cells(iRows, 4).Value End If .. 它没有赋值单元格（iRows,4）.value 到单元格（,35）
-
如果无法访问您的数据，就不可能诊断出为什么某个特定语句无法给出您所寻求的结果。但是，您的代码难以诊断的原因有很多。我将开始研究您的代码并创建一个解释如何改进它的答案。我将分阶段发布答案，以便您思考我在写什么。
标签： excel vba loops if-statement outlook