Alle automatisch aflopen en mailen bij openen formulier

[Robert971]

Beste,

Ik zou graag via een functie alle records laten doorlopen van een formulier dat wordt geopend, en deze records vervolgens 1 voor 1 met veldinformatie automatisch mailen naar betreffende persoon. Ik probeer alle records te laten doorlopen via de onderliggende tabel van het formulier. Het vervelende is dat steeds hetzelfde record wordt gemaild. Stel er staan bijv. 60 records in een tabel, dan wordt bijv. 60 keer het 1e record gemaild...Het lijkt dus of de functie niet overspringt naar het volgende record.. Maar steeds alleen het geselecteerde record pakt. Want als ik een ander willekeurig records selecteer (en de functie laat aflopen), wordt dat record 60 keer gemaild.
Dit is uiteraard niet de bedoeling, alle records behoren 1 voor 1 uniek afgelopen te worden en gemaild te worden naar betreffende.
Mijn functie is als volgt:

Private Sub Form_Load()

Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("TabelWerknemers")

If rs.RecordCount <> 0 Then
 rs.MoveFirst
 While Not rs.EOF
  rs.MoveNext
   
  Set ol = CreateObject("Outlook.application")
  Set NewMessage = ol.CreateItem(olMailItem)

   With NewMessage

    .to = "Test@test.nl"

    .Subject = "Fiattering:"
   
    .Body = vbCrLf & vbCrLf & "Task:  " & Me.Roepnaam & " - " & Me.Achternaam & " "
   
    .Send
   
   End With
   
   
 Wend
'Loop

End If
rs.Close
Set rs = Nothing


End Sub

Iemand misschien een idee hoe dit op te lossen? De mailfunctie werkt verder prima. Het gaat dus puur om het 1 voor 1 aflopen van de verschillende records en deze afzonderlijk te mailen naar betreffende. 60 records geeft dan dus 60 verschillende mailtjes.

Bvd.

 

[OctaFish]

Ik doe altijd dit:

Set rs = CurrentDb.OpenRecordset("TabelWerknemers")
Set ol = CreateObject("Outlook.application")
Do While Not rs.EOF
  Set NewMessage = ol.CreateItem(olMailItem)
   With NewMessage
    .to = "Test@test.nl"
    .Subject = "Fiattering:"   
    .Body = vbCrLf & vbCrLf & "Task:  " & Me.Roepnaam & " - " & Me.Achternaam & " " 
    .Send 
   End With
   rs.MoveNext   
Loop

En dat werkt doorgaans prima.

 

[Robert971]

Bij mij bleef de code maar steken op hetzelfde record. Ik heb het uiteindelijk anders op moeten oplossen om het werkend te kregen. Heb het rs.MoveNext statement vervangen voor een ander commando. Of het de meest fraaie oplossing is betwijfel ik, maar het werkt gelukkig. Zie onderstaand de code zoals deze bij mij goed werkt..

On Error GoTo Form_ErrorHandler_Err

Set rs = CurrentDb.OpenRecordset("TabelWerknemers")
Set ol = CreateObject("Outlook.application")

Do While Not rs.EOF
  Set NewMessage = ol.CreateItem(olMailItem)
   With NewMessage
    .to = "Test@test.nl"
    .Subject = "Fiattering:"
    .Body = vbCrLf & vbCrLf & "Task:  " & Me.Roepnaam & " - " & Me.Achternaam & " "
    .Send
   End With
   [COLOR="#0000FF"]DoCmd.GoToRecord , "", acNext[/COLOR]
Loop

Form_ErrorHandler_Exit:
Exit Sub

Form_ErrorHandler_Err:
 Resume Form_ErrorHandler_Exit

Zoals je ziet ook een deel van jou code gebruikt, thanks dus!

 

[OctaFish]

Ik vind het een rare oplossing, want rs.MoveNext moet gewoon werken. Maar als het in deze db werkt, moet je het misschien maar zo laten, maar ik zou wel uitzoeken waarom rs.MoveNext niet werkt. Want dat is absurd. Je kunt er nog een ADO recordset van maken bijvoorbeeld, om wat anders uit te proberen. Hier een voorbeeldje wat ik zelf zonder problemen gebruik:

Sub Leefomstandigheden()
Dim rs As DAO.Recordset, NewLine As Variant
    Set rs = CurrentDb.OpenRecordset("SELECT leefsituatie, woonsituatie,Leefomstandigheden FROM tPersonen")
    With rs
        Do While Not .EOF
            .Edit
            If Not !leefsituatie = "" And Not !woonsituatie = "" Then NewLine = vbCrLf Else: NewLine = ""
            !Leefomstandigheden = IIf(!leefsituatie <> "", !leefsituatie, "") & NewLine & IIf(!woonsituatie <> "", !woonsituatie, "")
            .Update
            .MoveNext
        Loop
    End With
End Sub