CODE ERROR

mrbeanyuk

Board Regular
Joined
Nov 30, 2005
Messages
212
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
 

Some videos you may like

Excel Facts

Create a chart in one keystroke
Select the data and press Alt+F1 to insert a default chart. You can change the default chart to any chart type

mrbeanyuk

Board Regular
Joined
Nov 30, 2005
Messages
212
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

Well-known Member
Joined
Oct 14, 2005
Messages
748
Where is related the argument lRow within the code of the function EmailToThisAddress(lRow As Long)?

GALILEOGALI
 

Watch MrExcel Video

Forum statistics

Threads
1,122,382
Messages
5,595,853
Members
414,027
Latest member
zippyfrog

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top