Add an Attachment to email and Copy data into Email Body

Hi All
I am currently creating a macro to be able to add an attachment to an email and also have my summary copied into my email body but it keeps coming up with Run-time Error '1004'
Could someone please help as i cant figure out what is causing it
The coding that i have used is;
Dim objOutlook As Object
Dim objNameSpace As Object
Dim objInbox As Object
Dim objMailItem As Object
Set objOutlook = CreateObject("Outlook.Application")
Set objNameSpace = objOutlook.GetNamespace("MAPI")
Set objInbox = objNameSpace.Folders(1)
Set objMailItem = objOutlook.CreateItem(0)
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object

Set rng = Nothing
On Error Resume Next

Set rng = Sheets("Summary").Range("A1:O45").SpecialCells(xlCellTypeVisible)

On Error GoTo 0

If rng Is Nothing Then
MsgBox "The selection is not a range or the sheet is protected" & _
vbNewLine & "please correct and try again.", vbOKOnly
Exit Sub
End If

More coding

With Worksheets("Summary")
Do
strTo = strTo & .Cells(i, 1).Value & "; "
i = i + 1
Loop Until IsEmpty(.Cells(i, 1))
End With

With Application

.EnableEvents = False
.ScreenUpdating = False
End With

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

strTo = Mid(strTo, 1, Len(strTo) - 2)

With objMailItem
.to = ""
.CC = ""
.Subject = "Example attachment to multiple recipients"
.Attachments.Add ActiveWorkbook.FullName
.HTMLBody = rangetoHTML(rng)
.Display 'Change to Send if you want to just send it.
End With

With Application
.EnableEvents = True
.ScreenUpdating = True
End With

Set objOutlook = Nothing
Set objNameSpace = Nothing
Set objInbox = Nothing
Set objMailItem = Nothing
Set OutMail = Nothing
Set OutApp = Nothing

End Sub

Sorted it

.Attachments.Add ActiveWorkbook.FullName