Send enkelt mail, med flere oplysninger?

Sub afsendAfBesked()
Dim modtager As String, linje As String

    modtager = Range("D1")
    linje = "Dato" & vbTab & vbTab & "Aktivitet" & vbTab & vbTab & "Timer" & vbCr
   
    For ræk = 1 To ActiveCell.SpecialCells(xlLastCell).Row
        Range("K" & ræk).Activate
        If ActiveCell.Offset(0, -7) <> modtager Then
            sendMail mail, navn, linje
            modtager = Range("F" & ræk)
            linje = "Dato" & vbTab & vbTab & "Aktivitet" & vbTab & vbTab & "Timer" & vbNewLine
        End If
       
        With ActiveSheet
            Set navn = ActiveCell.Offset(0, -7)
            Set orgenhed = ActiveCell.Offset(0, -10)
            Set akt = ActiveCell.Offset(0, -5)
            Set aktnavn = ActiveCell.Offset(0, -6)
            Set regt = ActiveCell
            Set link = ActiveCell.Offset(0, 1)
            Set bemærkning = ActiveCell.Offset(0, 2)
            Set mail = ActiveCell.Offset(0, 3)
            Set dag = ActiveCell.Offset(0, -4)
           
            linje = linje & dag & vbTab & vbTab & aktnavn & vbTab & vbTab & regt & vbNewLine
        End With

    Next ræk
   
Rem sidste modtager
    sendMail mail, navn, linje
End Sub
Private Sub sendMail(mail, navn, linje)
      Set objOutlook = CreateObject("Outlook.Application")
      Set objmail = objOutlook.CreateItem(0)
     
      With objmail
          .To = mail
          .Subject = "Fejlregistering på aktivitetsniveau"
          .CC = ""
         
          .body = "Hej" & " " & navn & vbNewLine & vbNewLine & "Vi har fundet nedenstående fejlregisterering der er generet efter et kriterie opsat efter din afdeling." _
          & vbNewLine & vbNewLine & "Du har registeret dig på følgende:" & vbNewLine & linje & vbNewLine & "Med venlig hilsen" & vbNewLine & "Controllerenheden"
      End With
     
      objmail.send
End Sub

Mange tak for det hurtige svar.

Jeg har nu nedenståeden kode, layoutet og outputtet passer perfekt.

Men der bliver oprettet en mail, pr. hver fejl reg., hvor den gerne skulle lave en liste med alle fejl reg. pr. person. således at hvis en person har 5 fejl reg. bliver de listet i kun 1 mail i stedet for 5 mails.

Datasættet er sorteret efter navn, således at en persons fejl registreringerne kommer lige efter hinaden.

Håber du kan hjælpe :)


Private Sub afsendAfBesked()
   
Worksheets("Mail").Activate
 
Dim modtager As String, linje As String
       

modtager = Range("g2") ' = Personens navn
linje = "Dato" & vbTab & vbTab & "Aktivitet" & vbTab & vbTab & "Timer" & vbCr

For ræk = 1 To ActiveCell.SpecialCells(xlLastCell).Row
    Range("N" & ræk).Activate ' N kolonnen = fejlreg. timer
    If ActiveCell.Offset(0, -7) <> modtager Then
        SendMail mail, navn, linje
        modtager = Range("N" & ræk) ' N kolonnen = fejlreg. timer
        linje = "Dato" & vbTab & vbTab & "Aktivitet" & vbTab & vbTab & vbTab & vbTab & "Timer" & vbNewLine
End If

With ActiveSheet
    Set navn = ActiveCell.Offset(0, -7)
    Set orgenhed = ActiveCell.Offset(0, -10)
    Set akt = ActiveCell.Offset(0, -5)
    Set aktnavn = ActiveCell.Offset(0, -6)
    Set regt = ActiveCell
    Set link = ActiveCell.Offset(0, 1)
    Set bemærkning = ActiveCell.Offset(0, 2)
    Set mail = ActiveCell.Offset(0, 3)
    Set dag = ActiveCell.Offset(0, -4)
   
    linje = linje & dag & vbTab & vbTab & aktnavn & " " & akt & vbTab & vbTab & regt & vbNewLine
End With

Next ræk
Rem sidste modtager
  SendMail mail, navn, linje
End Sub

Private Sub SendMail(mail, navn, linje)

  Set objOutlook = CreateObject("Outlook.Application")
  Set objMail = objOutlook.CreateItem(0)
 
   
      With objMail
        .To = mail
        .Subject = "Fejlregistering på aktivitetsniveau"
        .CC = ""
        .body = "Hej" & " " & navn & vbNewLine & vbNewLine & "Vi har fundet nedenstående fejlregisterering der er generet efter et kriterie opsat efter din afdeling." _
        & vbNewLine & vbNewLine & "Du har registeret dig på følgende:" & vbNewLine & vbNewLine & linje & vbNewLine & vbNewLine
           
        objMail.display 'Instead of .Display, you can use .Send to send the email or .Save to save a copy in  the drafts folder
       
      End With

End Sub

Selv tak
De forudsætninger, du nævner, er også tilgodeset i min model, som jeg også har kørt test på, hvilket fungerede.

Prøv at steppe gennem din kode med F8 - så kan du følge forløbet.
Indret vinduerne så du både kan se VBA-vinduet og data.

Så fik jeg den til virke, mange tak skal du have - det var celledestinationen, der var problemet.

Selve layoutet i mailen opfører sig mærkeligt, selvom der bliver anvendt vbTab.

Det går galt når -aktnavn- bliver over ca 15 karakter, så rykker hele layoutet sig. Er det noget du har en løsning på?

Mvh

Martin

Evt. kunne -aktnavn- bliver placeret sidst i linen.

Det blev også løsningen på det, mange tak for din hjælp :)


Jeg oprettet et spørgsmål mere, med nye point - hvis du måske har tid.
http://www.eksperten.dk/spm/1002023


Mvh

Martin

Selv tak - jeg ser på dit nye spørgsmål..