Hvor skal Do While løkken indsættes i kode, for at den vedhæfter filer i samtlige mails

Har denne Do while kode, der skal indsættes i koden længere nede, men jeg kan IKKE få det til at "spille" . enten tager den kun den første record modtager og attacher alle filerne ved eller også er det kun sidste record ... kan et skarpt hoved hjælpe ?
-----------------------------
Do Whilee kode :
-----------------------------

Do While Len(strFile) > 0
        outMail.Attachments.Add (strPath & strFile)
        strFile = Dir
  Loop


-------------------------------------------------------
Koden jeg gerne vil have sat Do While ind i  ( det hele virker undtagen vedhæftning af filer/ne
-------------------------------------------------------
Private Sub cmb_Send_mail_Ver2_Click()
Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim emailTo As String
    Dim emailSubject As String
    Dim emailText As String
    Dim outApp As Outlook.Application
    Dim outMail As Outlook.MailItem
    Dim outlookStarted As Boolean
    Dim strPath As String
    Dim strFilter As String
    Dim strFile As String

   
strPath = "C:\#_Export\xml_2\"
'TESTES senere 07 OKT 2017 18:08
    'strPath = "C:\#_Export\" & rs.Fields("Email") & "\"
    strFilter = "*.*"
    strFile = Dir(strPath & strFilter)

  ' If strFile <> "" Then
    On Error Resume Next
    Set outApp = GetObject(, "Outlook.Application")
    On Error GoTo 0
    If outApp Is Nothing Then
        Set outApp = CreateObject("Outlook.Application")
        outlookStarted = True
    End If

    Set db = CurrentDb
    Set rs = db.OpenRecordset("SELECT email,firstname,lastname, telefon,isVIP FROM tbl_emails")
    Do Until rs.EOF

        emailTo = rs.Fields("Email").Value
        emailSubject = "Amazing newsletter"
        If IsNull(rs.Fields("FirstName").Value) Then
            emailSubject = emailSubject & " for " & _
                            rs.Fields("FirstName").Value & " " & rs.Fields("LastName").Value
        End If
       
        emailText = Trim("Hej " & rs.Fields("FirstName").Value) & " !" & vbCrLf
       
        If rs.Fields("IsVIP").Value Then
            emailText = emailText & "Specialtilbud for vore VIP-kunder !" & _
                        "Kun i denne måned ..." & vbCrLf
        End If
       
        emailText = emailText & vbCrLf & "Telefonnummer  : " & "<B>" & rs.Fields("telefon").Value & _
vbCrLf & "Fulde navn : " & rs.Fields("FirstName").Value & " " & rs.Fields("LastName").Value & _
Me.info_txt
          Set outMail = outApp.CreateItem(olMailItem)
 

     
        Set outMail = outApp.CreateItem(olMailItem)
        outMail.To = emailTo
        outMail.SentOnBehalfOfName = "Julemanden@jul.dk"
        outMail.BodyFormat = olFormatHTML
        outMail.Subject = emailSubject
        outMail.HTMLBody = emailText
     
     

     
      ' HTMLBody = "<font face='Verdana' size='2'>" & emailText
  '      outMail.Send
outMail.Display
       
       
        rs.MoveNext
    Loop
 
    rs.Close
    Set rs = Nothing
    Set db = Nothing
   
    If outlookStarted Then
        outApp.Quit
    End If
   
    Set outMail = Nothing
    Set outApp = Nothing

End Sub
-----------------------------------------
End Code
-----------------------------------------
mvh martens