VBA Code not populating worksheet

Question

The code below is sourced from another SO post: Excel VBA Code to retrieve e-mails from outlook.

THe purpose is to find information from Outlook e-mails and put them into 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

End Sub

WHen i debug and hover over the last few lines, it seems the code is extracting information from Outlook properly. However, the extracted data(subject of e-mail, etc) aren't populated in my worksheet. From what I can gather I've set the worksheet variable correctly, don't really know what's going on.

Thanks for all the help

Update:

Worksheet is populating now. I am trying to get the code to go through a column of e-mail addresses, and extract "time received" from the emails if the addresses match with those in my folders.

@findwindow the instr function is looking to see if today's date is in the date received line. I bet the problem is that there are no emails from today in which to look, which would return a 0. or there are no subject lines that have "Reminder" in them. Edit: My guess is that the OP does not really understand what the code does as it appears to be a direct copy and paste from the original. — Scott Craner, Oct 01 '15 at 21:19
You shouldn't use `InStr(olMail.ReceivedTime, x)` to compare time/date. create another date type variable for the ReceivedTime. Then compare with their `Year()`, `Month()`, and `Day()` parts. — PatricK, Oct 01 '15 at 23:41
Well, you don't have `iCounter` in your code XD Or did you add that? Update your OP to reflect latest code? Also, please start deleting comments to keep this less cluttered. — findwindow, Oct 02 '15 at 17:12
To look through worksheet you need to qualify the cell and we might need a second counter. — findwindow, Oct 02 '15 at 17:14
Updated the OP code. I did add the `dim iCounter as Long` line, as well as `For iCounter = 2 to lastRow` and `lastrow= ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count, "L").End(xlUp).Row`. Right now there's no compile error but worksheet isn't populating, when I debug it goes through the lines but skips over `.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` — Daruki, Oct 02 '15 at 17:45
I realized my mistake, refer to my edited comment above, thanks! — Daruki, Oct 02 '15 at 17:49
Your `lrow` and `lastRow` don't match. Are you sure? Edit: er maybe understand what you're doing. Try adding `ws.` before your cells so it reads `ws.Cells(iCounter, 5).Value` — findwindow, Oct 02 '15 at 17:50

score 2 · Accepted Answer · answered Oct 02 '15 at 17:56

Made some changes. See if this works.

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

yes it works now! im taking a look at your code, and i realize i tried a variation that had all the components your code has(`lastRow = ThisWorkbook.WorkSheets("Sheet1").Cells(Rows.Count, "L").End(xlUp).Row,` but it didn't work before. I realized my error when I tried your code out - i inputted the reference e-mail address in the workbook as Darrin@gmail, when it should've been darrin@gmail - your code didn't work until i made that minor adjustment. now my variations work as well! thanks so much i've learned a lot, also thanks for your criticism earlier :) — Daruki, Oct 02 '15 at 18:13
Hmm try `InStr(olMail.SenderEmailAddress, ws.Cells(i, 5).Value, vbTextCompare)` with `Darrin@gmail` — findwindow, Oct 02 '15 at 18:17
It gives me a type mismatch error. I took out the for/next iCounter lines just in case, but still the same error. If there's no way around the case sensitivity i'm fine with it, i appreciate your help! — Daruki, Oct 02 '15 at 18:26

score 0 · Answer 2 · answered Oct 01 '15 at 23:36

Are the emails you're looking for in your inbox or a subfolder? The code is ONLY looking in each FOLDER in the inbox, it's not looking in the actual inbox.

Try these changes:

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

VBA Code not populating worksheet

2 Answers2