Hvorfor ingen vedhæftninger?

Hey Alle

Jeg forsøger at lave en DB til nogle ansøgninger, og i den forbindelse vil jeg gerne sende en mail med de ansøgninger som er kommet til et givent job.
Ansøgningerne ligger som word-filer og stien til filen står i en tabel der hedder [ansøgning] under [mailadresse].

Jeg har fundet noget kode på nettet som jeg har pillet lidt ved, men jeg kan ikke helt få det til at virke...

Jeg kan godt vedhæfte 1 fil til mailen og sende den, men jeg vil vedhæfte flere filer.
Hvor er det lige fejlen er?

KODEN:


Option Compare Database
Option Explicit

' Declare module level variables
Dim mOutlookApp As Outlook.Application
Dim mNameSpace As Outlook.NameSpace
Dim mFolder As MAPIFolder
Dim mItem As MailItem
Dim fSuccess As Boolean


' Module contains only 2 methods:
'    1) GetOutlook()
'    2) SendMessage()
'
Public Function GetOutlook() As Boolean
' The GetOutlook() function sets the Outlook Application
' and Namespase objects and opens MS Outlook
On Error Resume Next

' Assume success
fSuccess = True

Set mOutlookApp = GetObject("", "Outlook.application")

' If Outlook is NOT Open, then there will be an error.
' Attempt to open Outlook
If Err.Number > 0 Then
  Err.Clear
  Set mOutlookApp = CreateObject("Outlook.application")
  If Err.Number > 0 Then
      MsgBox "Could not create Outlook object", vbCritical
      fSuccess = False
      Exit Function
  End If
End If

' If we've made it this far, we have an Outlook App Object
' Now, set the NameSpace object to MAPI Namespace
Set mNameSpace = mOutlookApp.GetNamespace("MAPI")
 
If Err.Number > 0 Then
  MsgBox "Could not create NameSpace object", vbCritical
  fSuccess = False
  Exit Function
End If

' Return the Success Flag as the value of GetOutlook()
GetOutlook = fSuccess
End Function
Public Function SendMessage() As Boolean
' The SendMessage() function reads user entered values and
' actually sends the message.

On Error Resume Next
Dim strRecip As String
Dim strSubject As String
Dim strMsg As String
Dim strAttachment As String
Dim MyDB As Database, RS As Recordset
Dim StrBody As String, lngCount As Long, lngRSCount As Long

'DoCmd.RunCommand acCmdSaveRecord
Set MyDB = CurrentDb
Set RS = MyDB.OpenRecordset("ansøgning")

strSubject = "Dette er emnet"
strRecip = "jademutter@mail.dk"
StrBody = "Og dette er indholdet"
' Any amount of validation could be done at this point, but
' at a minimum, you need to verify that the user supplied an
' Email address for a recipient.
' Assume success
fSuccess = True
' Here's where the real Outlook Automation takes place
If GetOutlook = True Then
  Set mItem = mOutlookApp.CreateItem(olMailItem)
  mItem.Recipients.Add strRecip
  mItem.Subject = strSubject
  mItem.Body = StrBody
   
    lngRSCount = RS.RecordCount()
    If lngRSCount = 0 Then
      MsgBox "Ingen filer blev vedhæftet", vbInformation
    Else
      RS.MoveLast
      RS.MoveFirst
      Do Until RS.EOF
        lngCount = lngCount + 1
        strAttachment = RS!stiTilAnsøgning
        mItem.attachments.Add strAttachment
        ' Send the email using some technique or other
        RS.Update
        RS.MoveNext
      Loop
    End If
    RS.Close
    MyDB.Close
    Set RS = Nothing
    Set MyDB = Nothing
    Close
    mItem.Send
End If
' Release resources
Set mOutlookApp = Nothing
Set mNameSpace = Nothing

If Err.Number > 0 Then fSuccess = False

SendMessage = fSuccess

End Function