Change the value for email and ws. You might also want to change .Send to .Display to test.
Option Explicit
Dim oOFs() As outlook.Folder
Sub SendReminder()
Dim email$, v, item, i, ws As Worksheet, r As Range, c As Range, cc As Range
'Tools > References > Microsoft Outlook xx.0 Object Library > OK
Dim OL As outlook.Application, oMI As outlook.MailItem
email = "ken@gmail.com"
Set ws = Worksheets("SendReminder")
Set r = ws.Range("I2", ws.Cells(ws.Rows.Count, "I").End(xlUp))
Set OL = CreateObject("Outlook.Application")
Erase oOFs()
RecurseOFolders GetFolderPath(email, OL)
For Each c In r
Set oMI = Nothing
Set cc = ws.Cells(c.Row, "P")
If cc > Date Or cc = "" Then GoTo NextC
For Each v In oOFs
If v.Items.Count = 0 Then GoTo NextV
For Each item In v.Items
If TypeName(item) <> "MailItem" Then GoTo NextItem
If item.SenderEmailAddress = c Then
If oMI Is Nothing Then Set oMI = item
If item.ReceivedTime > oMI.ReceivedTime Then Set oMI = item
End If
NextItem:
Next item
NextV:
Next v
NextC:
If Not oMI Is Nothing Then
With oMI.Reply
.Subject = ws.Cells(c.Row, "Q")
.Body = ws.Cells(c.Row, "S") & vbCrLf & vbCrLf & ws.Cells(c.Row, "T") & .Body
If ws.Cells(c.Row, "U") <> "" Then .Attachments.Add ws.Cells(c.Row, "U")
.Send
End With
End If
Next c
End Sub
Sub RecurseOFolders(CurrentFolder As outlook.MAPIFolder, _
Optional skipTrash As Boolean = True)
'Tools > References > Microsoft Outlook xx.0 Object Library > OK
Dim i As Long, oOSF As outlook.MAPIFolder, oOF As outlook.Folder
Dim ii As Long
For i = CurrentFolder.Folders.Count To 1 Step -1
Set oOF = CurrentFolder.Folders(i)
If IsArray(oOFs) Then
ii = UBound(oOFs) + 1
Else: ii = 0
End If
If skipTrash And oOF.Name = "Trash" Then
ii = ii - 1
Else
ReDim Preserve oOFs(ii)
Set oOFs(ii) = oOF
End If
Next i
For Each oOSF In CurrentFolder.Folders
If oOSF.Name <> "Deleted Items" Then RecurseOFolders oOSF
Next oOSF
End Sub
'Similar to, http://www.slipstick.com/developer/working-vba-nondefault-outlook-folders/#GetFolderPath
''Early Binding: Tools > References > Microsoft Outlook xx.0 Object Library > OK
Function GetFolderPath(ByVal FolderPath As String, oApp As outlook.Application) As outlook.Folder
Dim oFolder As outlook.Folder
Dim FoldersArray As Variant
Dim i As Integer
On Error GoTo GetFolderPath_Error
If Left(FolderPath, 2) = "\\" Then
FolderPath = Right(FolderPath, Len(FolderPath) - 2)
End If
'Convert folderpath to array
FoldersArray = Split(FolderPath, "\")
'Set oFolder = Application.Session.Folders.Item(FoldersArray(0))
Set oFolder = oApp.Session.Folders.item(FoldersArray(0))
If Not oFolder Is Nothing Then
For i = 1 To UBound(FoldersArray, 1)
Dim SubFolders As outlook.Folders
Set SubFolders = oFolder.Folders
Set oFolder = SubFolders.item(FoldersArray(i))
If oFolder Is Nothing Then
Set GetFolderPath = Nothing
End If
Next
End If
'Return the oFolder
Set GetFolderPath = oFolder
Exit Function
GetFolderPath_Error:
Set GetFolderPath = Nothing
Exit Function
End Function