Schleife funktioniert nicht

Sub Emailsenden()
Dim OutApp As Object
Dim OutMail As Object
Dim Fname As String
Dim wksData As Worksheet
Dim iRow As Integer
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
iRow = 1
Fname = ActiveWorkbook.Path & Application.PathSeparator & ActiveSheet.Cells(iRow, 1).Value & _
".txt"
Do Until IsEmpty(ActiveSheet.Cells(iRow, 1))
On Error Resume Next
With OutMail
.To = ActiveSheet.Cells(iRow, 2).Value
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.body = "Hi there"
.Attachments.Add Fname
.send   'or use .Display
End With
Set OutMail = Nothing
Set OutApp = Nothing
On Error Resume Next
iRow = iRow + 1
Loop
End Sub