Code was working and not has stopped - Mass Email

[officemanager2]

Hi There: I've posted this code before and it was working fine, but not for some reason when it runs it only inputs one email from the query, and it is not even the first email??

Public Sub MassEmail()

Dim db As DAO.Database
Dim MailList As DAO.Recordset
Dim MyOutlook As Outlook.Application
Dim MyMail As Outlook.MailItem
Dim Subjectline As String
Dim BodyFile As String
Dim fso As FileSystemObject
Dim MyBody As TextStream
Dim MyBodyText As String


Set fso = New FileSystemObject

'Create Subject line
Subjectline$ = InputBox$("Please enter the subject line for this mailing.")

'Open Outlook
Set MyOutlook = Outlook.Application

'Set up the database query connections
Set db = CurrentDb()

Set MailList = db.OpenRecordset("emailall")

    Set MyMail = MyOutlook.CreateItem(olMailItem)
    Do Until MailList.EOF
    MyMail.Bcc = MailList("emailaddress")
    MailList.MoveNext

'Inputs subject line
MyMail.Subject = Subjectline$

Loop

MyMail.Display

MailList.Close
Set MailList = Nothing

End Sub

Any suggestions at all as to why I'm only getting one email now?

 

[officemanager2]

Ok the loop was in the wrong spot!

sorry mods, feel free to delete this.