VBA 代码未填充工作表答案

【问题标题】：VBA Code not populating worksheetVBA 代码未填充工作表
【发布时间】：2015-12-30 01:08:56
【问题描述】：

以下代码来自另一篇 SO 帖子：Excel VBA Code to retrieve e-mails from outlook。

目的是从 Outlook 电子邮件中查找信息并将其放入 Excel。

Sub test2()
Dim olApp As Outlook.Application
Dim olNs As Outlook.Namespace
Dim olFolder As Outlook.MAPIFolder
Dim olMail As Outlook.MailItem
Dim eFolder As Outlook.Folder
Dim i As Long
Dim x As Date
Dim wb As Workbook
Dim ws As Worksheet
Dim iCounter As Long
Dim lrow As Long

Set wb = ActiveWorkbook
Set ws = wb.Worksheets("Sheet1")
wb.Activate
ws.Select

Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
x = Date


For Each eFolder In olNs.GetDefaultFolder(olFolderInbox).Folders
Set olFolder = olNs.GetDefaultFolder(olFolderInbox).Folders(eFolder.Name)
For i = olFolder.Items.Count To 1 Step -1

 If TypeOf olFolder.Items(i) Is MailItem Then
        Set olMail = olFolder.Items(i)
            For iCounter = 2 To lrow
            If InStr(olMail.SenderEmailAddress, ws.Cells(iCounter, 5).Value) > 0 Then
                With ws
                   lrow = .Range("A" & .Rows.Count).End(xlUp).Row
                   .Range("A" & lrow).Offset(1, 0).Value = olMail.Subject
                   .Range("A" & lrow).Offset(1, 1).Value = olMail.ReceivedTime
                   .Range("A" & lrow).Offset(1, 2).Value = olMail.SenderEmailAddress
                End With
            End If
            Next iCounter
        End If
    Next i
    Set olFolder = Nothing
Next eFolder

结束子

当我调试并悬停在最后几行时，似乎代码正在正确地从 Outlook 中提取信息。但是，提取的数据（电子邮件主题等）并未填充到我的工作表中。据我所知，我已经正确设置了工作表变量，不知道发生了什么。

感谢大家的帮助

更新：

现在正在填充工作表。我试图让代码通过一列电子邮件地址，如果地址与我文件夹中的地址匹配，则从电子邮件中提取“收到时间”。

【问题讨论】：

@findwindow instr 函数正在查看今天的日期是否在收到的日期行中。我敢打赌，问题是今天没有可以查看的电子邮件，这将返回 0。或者没有包含“提醒”的主题行。编辑：我的猜测是 OP 并不真正理解代码的作用，因为它似乎是从原始文件直接复制和粘贴。
您不应该使用InStr(olMail.ReceivedTime, x) 来比较时间/日期。为 ReceivedTime 创建另一个日期类型变量。然后与他们的Year()、Month() 和Day() 部分进行比较。
好吧，你的代码中没有iCounter XD 或者你添加了那个？更新您的 OP 以反映最新代码？另外，请开始删除 cmets 以减少混乱。
要查看工作表，您需要限定单元格，我们可能需要第二个计数器。
更新了 OP 代码。我确实添加了dim iCounter as Long 行，以及For iCounter = 2 to lastRow 和lastrow= ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count, "L").End(xlUp).Row。现在没有编译错误，但工作表没有填充，当我调试它时，它会通过行但跳过.Range("A" & lrow).Offset(1, 0).Value = olMail.Subject .Range("A" & lrow).Offset(1, 1).Value = olMail.ReceivedTime .Range("A" & lrow).Offset(1, 2).Value = olMail.SenderEmailAddress

标签： vba excel outlook

【解决方案1】：

做了一些改动。看看这是否有效。

Dim olApp As Outlook.Application
Dim olNs As Outlook.Namespace
Dim olFolder As Outlook.MAPIFolder
Dim olMail As Outlook.MailItem
Dim eFolder As Outlook.folder
Dim i As Long
Dim x As Date
Dim wb As Workbook
Dim ws As Worksheet
Dim iCounter As Long
Dim lrow As Long

Set wb = ActiveWorkbook
Set ws = wb.WorkSheets("Sheet1")

Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
x = Date

'i think you want column E here, not L?
lastRow = ThisWorkbook.WorkSheets("Sheet1").Cells(Rows.Count, "L").End(xlUp).Row

For Each eFolder In olNs.GetDefaultFolder(olFolderInbox).Folders
Set olFolder = olNs.GetDefaultFolder(olFolderInbox).Folders(eFolder.name)
For i = olFolder.Items.Count To 1 Step -1
For iCounter = 2 To lastRow
 If TypeOf olFolder.Items(i) Is MailItem Then
        Set olMail = olFolder.Items(i)
            If InStr(olMail.SenderEmailAddress, ws.Cells(iCounter, 5).Value) > 0 Then 'qualify the cell
                With ws
                   lrow = .Range("A" & .Rows.Count).End(xlUp).Row
                       .Range("A" & lrow + 1).Value = olMail.SUBJECT
                       .Range("B" & lrow + 1).Value = olMail.ReceivedTime
                       .Range("C" & lrow + 1).Value = olMail.SenderEmailAddress
                End With
            End If
            Next iCounter
        End If
    Next i
    Set olFolder = Nothing

【讨论】：

是的，它现在可以工作了！我正在查看您的代码，我意识到我尝试了一个包含您的代码所有组件的变体（lastRow = ThisWorkbook.WorkSheets("Sheet1").Cells(Rows.Count, "L").End(xlUp).Row, 但它之前没有工作。当我尝试您的代码时我意识到我的错误 - 我输入了参考工作簿中的电子邮件地址为 Darrin@gmail，本来应该是 darrin@gmail - 您的代码在我进行细微调整之前无法正常工作。现在我的变体也能正常工作！非常感谢，我学到了很多，也感谢您之前的批评:)
嗯，试试InStr(olMail.SenderEmailAddress, ws.Cells(i, 5).Value, vbTextCompare) 和Darrin@gmail
它给了我一个类型不匹配的错误。为了以防万一，我取出了 for/next iCounter 行，但仍然是同样的错误。如果没有办法区分大小写，我可以接受，感谢您的帮助！

【解决方案2】：

您要查找的电子邮件是在收件箱还是子文件夹中？该代码仅在收件箱中的每个文件夹中查找，而不是在实际收件箱中查找。

试试这些改变：

Dim i As Long, j As Long 'Add "j as long"
'For Each eFolder In olNs.GetDefaultFolder(olFolderInbox).Folders
For j = 0 To olNs.GetDefaultFolder(olFolderInbox).Folders.Count ' loop through the folders, starting at 0 (which we'll call the inbox)
    If j = 0 Then
        Set olFolder = olNs.GetDefaultFolder(olFolderInbox)
    Else
        Set olFolder = olNs.GetDefaultFolder(olFolderInbox).Folders(j)
    End If
...rest of loop
Next ' Remove 'efolder' from here

【讨论】：