Assistance needed in downloading details of multiple email recipients (1 Viewer)

Private Sub sntml()
Dim rst As DAO.Recordset
Dim OlApp As Outlook.Application
Dim stfldr As Outlook.MAPIFolder
Dim stfldrItems As Outlook.Items
Dim Mailobject As Object
Dim db As DAO.Database
Dim dealer As Integer
Dim emailCount as integer

Set db = CurrentDb
Set OlApp = CreateObject("Outlook.Application")
Set stfldr = OlApp.GetNamespace("Mapi").GetDefaultFolder(olFolderSentMail)
Set rst= CurrentDb.OpenRecordset("ogmls")
Set stfldrItems = stfldr.Items
stfldrItems.Sort "[ReceivedTime]"
emailCount=1
For Each Mailobject In stfldrItems

    With rst
        .AddNew
        !Subject = Mailobject.Subject
        !from = Mailobject.SenderName
        !To = Mailobject.To
        !Body = Mailobject.Body
        !DateSent = Mailobject.SentOn
        .Update
        Mailobject.UnRead = False
    End With
    emailCount = emailCount+1
    if emailCount > 10 then 
      Exit For
    end if

Next
Set OlApp = Nothing
Set stfldr = Nothing
Set stfldrItems = Nothing
Set Mailobject = Nothing
Set rst = Nothing
End Sub

For Each Mailobject In stfldrItems

    If InStr(Mailobject.To, ";") > 0 Then
       vToList = Mailobject.To
       i = InStr(vToList, ";")
       While i > 0
          vWho = Left(vTos, i - 1)
          vToList = Mid(vTos, i + 1)
          Gosub Post1Rec
          i = InStr(vToList, ";")
       Wend
      vWho = vToList
      Gosub Post1Rec 
    Else
       vWho = Mailobject.To
       Gosub Post1Rec 
    End If
next

Set OlApp = Nothing
Set stfldr = Nothing
Set stfldrItems = Nothing
Set Mailobject = Nothing
Set rst = Nothing
exit sub


Post1Rec:
    With rst
        .AddNew
        !Subject = Mailobject.Subject
        !From = Mailobject.SenderName
        !To = Mailobject.To
        !Body = v1Who
        !DateSent = Mailobject.SentOn
        .Update
        Mailobject.UnRead = False
    End With
    emailCount = emailCount + 1
    If emailCount > 10 Then
      Exit For
    End If
return
End sub