Assistance needed in downloading details of multiple email recipients

[Voyager]

Hi team,
I am using the below given code to download mails into my db it works fine. However when downloading data from .to field I have a trouble sometimes emails are addressed to multiple recipients the current code only downloads data of one email address I wanted to download all the recipient details in different fields say to1 , to2 etc. is it possible could you assist me?

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

 

[Ranman256]

add in the routine to scan thru the TO list and break it up using semicolons separating the email addrs.

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

 

[Cronk]

Don't use multiple fields, one for each addressee. Very un-normalized and what will happen with a very long list of addressees.

Ranman's approach records a copy of the data for the email body, subject etc, for each addressee.

Another approach would be to create a child table with a foreign key field of the parent ID and one record containing each addressee.

 

[Voyager]

My hearty thanks to Ranman/ Cronk. Code works well. Though I am facing a new challenge now I will post it as new query since it’s partially connected to this. Thank you very much for the support.