Email af rapportskema

Jeg har skrevet lidt om det her i pkt. 12. Men det betyder at du skal markere hver enkelt modtager, og jeg antager, at er ude efter lidt mere automatiseret:

http://www.eksperten.dk/artikler/371

Hvis to modtagere skal modtage har samme værdi i RapportNavn, har de så også altid samme værdi i EmneRef?

Pyt. Det er ligemeget. Et bud på en (ikke-testet) løsning::

Function Email_Click()
  Dim rst As Recordset
  Dim RappRst As Recordset
  Dim strDate As String
  Dim RapNavn As String
  Dim Recipient As String
  Dim EmneRef As Long
  Dim Emne As String
  Dim Medd As String
   
  strDate = Format(Now, "dd-mm-yyyy")
   
  ' Hent alle rapportnavnene/emner
  Set RappRst = CurrentDb.OpenRecordset("SELECT RapportNavn, EmneRef FROM EmailModtager GROUP BY RapportNavn, EmneRef;")
  Do Until RappRst.EOF
   
    RapNavn = RappRst.Fields("RapportNavn")
    EmneRef = RappRst.Fields("EmneRef")
   
    Emne = DLookup("[Emne]", "EmneTabel", "[ID]=" & EmneRef)
    Medd = DLookup("[Meddelelsen]", "EmneTabel", "[ID]=" & EmneRef)
   
    Recipient = ""
    ' Hent alle modtagere af den aktuelle rapport med samme emne
    Set rst = CurrentDb.OpenRecordset("SELECT EmailModtager.* FROM EmailModtager WHERE RapportNavn='" & RapNavn & "' AND EmneRef=" & EmneRef)
    With rst
      ' Gennemløb modtagerne
      Do Until .EOF
        Recipient = Recipient & .Fields("EmailAdr") & ";"
        .MoveNext
      Loop
      ' Fjern sidste ;
      Recipient = Left(Recipient, Len(Recipient) - 1)
     
      DoCmd.SendObject acSendQuery, RapNavn, acFormatXLS, Recipient, , , Emne & " " & strDate, Medd, True
      .Close
    End With
    RappRst.MoveNext
  Loop
  RappRst.Close
 
  Set rst = Nothing
  Set RappRst = Nothing
End Function

Det var lige den kode jeg skulle bruge, og den virker. Jeg har ikke ændret noget som helst iden

Tak til fdata!

Herligt! Tak for point  ;o)