|
Option Explicit
Sub sbUsage()
Dim iRow As Long
Dim iRows As Long
Dim iCol As Long
Dim iItem As Long
Dim iItems As Long
Dim myInbox As Outlook.folder
Dim mySubfolder As Outlook.folder
Dim myItems As Outlook.Items
Dim myItem As Outlook.MailItem
Dim olkstore As Outlook.Store
Dim olkRoot As Outlook.folder
For Each olkstore In Outlook.Session.Stores
If olkstore.DisplayName = "davidtallett29@gmail.com" Then
Set olkRoot = olkstore.GetRootFolder
End If
Next
Set myInbox = olkRoot.Folders.Item("Inbox")
Set mySubfolder = myInbox.Folders("Newsletters")
Set myItems = myInbox.Items
If myItems.Count = 0 Then
MsgBox "No items to process ..."
Exit Sub
End If
iCol = 1
iRows = ActiveSheet.UsedRange.Rows.Count
iItems = myItems.Count
MsgBox "iItems " & iItems
MsgBox "iRows " & iRows
iItem = iItems ' start at the bottom of the Inbox
Start_loop:
If iItem = 0 Then GoTo Exit_Sub
DoEvents
Set myItem = myItems(iItem)
MsgBox "myItem.SenderEmailAddress " & myItem.SenderEmailAddress
For iRow = 1 To iRows
DoEvents
If myItem.SenderEmailAddress = Cells(iRow, iCol) Then
DoEvents
myItem.Move mySubfolder
DoEvents
MsgBox "moved ... " & myItem.SenderEmailAddress
MsgBox "iItem " & iItem
MsgBox "iRow " & iRow
iItem = iItem - 1
GoTo Start_loop
End If
Next iRow
iItem = iItem - 1
GoTo Start_loop
Exit_Sub:
MsgBox "Exit Sub..."
End Sub
|
|