CODE ERROR

[mrbeanyuk]

I would be really grateful if someone could tell me why I am getting 'Run-Time Error 13 Type Mismatch' pop up when I run this macro. I have spent literally hours trying to figure out whats wrong with it!!

Thanks

Option Explicit



Public Sub Main()

Dim lLR As Long 'last row
Dim lR As Long 'row
Dim lDate As Long 'current date
Dim lRDate As Long 'recorded date
Dim ws As Worksheet
Dim blnEmailSuccessful As Boolean
Dim xy As Long


' Choose the name of the spreadsheet you need - or capture it in someway as an input.
Set ws = Worksheets("Sheet1")

lLR = ActiveCell.SpecialCells(xlLastCell).Row
lR = 1
lDate = CLng(Date)


Do While lR <= lLR
If IsDate(ws.Cells(lR, 7)) = True Then
'If CLng(ws.Cells(lR, 7)) - lDate <= 3 Then
If DateDiff("d", Date, CDate(ws.Cells(lR, 7))) <= 3 Then
If ws.Cells(lR, 10) = "Email sent to " & ws.Cells(lR, 3) Then
xy = True
' Do nothing as the email is already sent
Else
If EmailToThisAddress(ws.Cells(lR, 3)) = False Then
ws.Cells(lR, 10) = "EMAIL FAILED"
ws.Cells(lR, 10).Select
Selection.Interior.ColorIndex = 3
Else
' send an email
ws.Cells(lR, 10) = "Email sent to " & ws.Cells(lR, 3)
ws.Cells(lR, 10).Select
Selection.Interior.ColorIndex = 4
End If
End If
End If
Else
ws.Cells(lR, 10) = "Date not set"
ws.Cells(lR, 10).Select
Selection.Interior.ColorIndex = 3
End If
lR = lR + 1

Loop

MsgBox "Complete", vbInformation
ws.Cells(3, 1).Select
Set ws = Nothing

End Sub

Public Function EmailToThisAddress(lRow As Long) As Boolean

On Error GoTo EmailToThisAddress_Err

Dim OutApp As Object
Dim OutMail As Object
Dim strto As String, strcc As String, strbcc As String
Dim strsub As String, strbody As String

ws.Cells(lR, 7) = ws.Cells(lR, 7)
ws.Cells(lR, 3) = ws.Cells(lR, 3)
sTitle = ws.Cells(lR, 2)

Set OutApp = CreateObject("Outlook.Application")
OutApp.session.logon
Set OutMail = OutApp.createitem(0)

strto = ws.Cells(lR, 3)
strcc = ""
strbcc = ""
strsub = "The " & sTitle & " is due on " & Format(ws.Cells(lR, 7), " dd mmm yy ")
strbody = "Please update the Org Branch Tracking Spreadsheet to reflect current status of completion."

With OutMail
.To = strto
.CC = strcc
.BCC = strbcc
.Subject = strsub
.Body = strbody
.Send
End With

Set OutMail = Nothing
Set OutApp = Nothing



EmailToThisAddress = True
Exit Function

EmailToThisAddress_Err:
EmailToThisAddress = False

End Function

 

[Lewiy]

Which line does the error occur on?

 

[mrbeanyuk]

Goes through the loop several times dependant on how many rows there are in the spreadsheet then it pops up on:

If EmailToThisAddress(ws.Cells(lR, 3)) = False Then


Thanks in advance!

 

[galileogali]

Where is related the argument lRow within the code of the function EmailToThisAddress(lRow As Long)?

GALILEOGALI