VBA Macro to send email from Excel Crashing

[PWHITTAK]

Urgently need some help completing this macro

I found this code on your Forum posted by John Davis (edited post by George Hart). I have edited it to suit my needs but is gives me an Active X error and fails. I have added a variant for the title. I want it to run automatically each day and go through column K to find Reminder Due and send a mail containing
I am getting an Active X error message and macro fails.

I would also like to Mark Column L for each reminder sent with "Reminder Sent & date.

Sub PennyW()


Dim x As Integer
Dim UserName As String
Dim MailDbName As String
Dim Recipient As Variant
Dim Contents As Variant
Dim Maildb As Object
Dim MailDoc As Object


Dim Session As Object
Dim stSignature As String


With Application


.ScreenUpdating = False
.DisplayAlerts = False


' Open and locate current LOTUS NOTES User


For x = 3 To Cells(Rows.Count, "K").End(xlUp).Row


If Range("K" & x) = "Reminder Due" Then


Set Session = CreateObject("Notes.NotesSession")
UserName = Session.UserName
MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
Set Maildb = Session.GetDatabase("", MailDbName)
If Maildb.IsOpen = True Then
Else
Maildb.OPENMAIL
End If


' Create New Mail and Address Title Handlers


Set MailDoc = Maildb.CREATEDOCUMENT


MailDoc.Form = "Memo"




' Select range of e-mail addresses
Recipient = Worksheets("Sheet1").Range("I" & x).Value

'Select a range of Body
Contents= Worksheets("Sheet1").Range("H" & x).Value


MailDoc.SendTo = Recipient
MailDoc.Subject = "Contract Renewal Reminder"
MailDoc.Body = Contents


MailDoc.SaveMessageOnSend = True


MailDoc.PostedDate = Now()
On Error GoTo errorhandler1
MailDoc.Send 0, Recipient


Set Maildb = Nothing
Set MailDoc = Nothing
Set Session = Nothing


.ScreenUpdating = True
.DisplayAlerts = True


errorhandler1:
Set Maildb = Nothing
Set MailDoc = Nothing
Set Session = Nothing
End If
Next x
End With
End Sub


​

Any help appreciated.