Automatisk mail fra Excel

Ja - via VBA skulle det ikke være et større problem.
Er det via OutLook, der skal sendes?

Du er velkommen til at sende din fil til: pb@supertekst-it.dk

Ja, det vil vel primært blive via Outlook... (Undskyld det sene svar! Har været udenlands et par dage...

Findes der et eksempel et eller andet sted på noget lignende? Ikke at jeg ikke vil sende filen, men jeg vil smaddergerne lære VBA - også sådan at jeg forstår, hvad der sker... Det ender jo nok med, at jeg kommer til at tage im od dit generøse tilbud...

Ok - det er nu ikke så sent...

Prøv at sende filen - så skal jeg forsøge at konstruere en "pædagogisk" løsning.

Rem VBA-koden er anbragt i ThisWorkbook
Rem Referencen til Microsoft Outlook 11.0 Object Library    '11.0 = version 2003 VBA-vinduet/Tools/References
Rem Checkbox-placering fra venstre:
Const FronterLeft = 193.5
Const HandCopyLeft = 245.25
Const startRæk = 12
Const slutRæk = 35
Dim cbNr As Byte, sh As Shape, ejAfleveretNavne As String
Rem Konstanter til mail:
Const mailModtager = "MIM@esh.dk"
Const mailEmne = "Følgende elever har ikke afleveret opgave - vedr.:"
Const mailAfslutning = vbCr + "Med venlig hilsen" + vbCr + "AfsenderNavn"
Rem ===============================
Public Sub testAflevering()

    Application.ScreenUpdating = False

Rem find første checkboxnr for disse i kolonnen Fronter
    For Each sh In ActiveSheet.Shapes
        If sh.Left = FronterLeft Then
            cbNr = udskilNr(sh.Name)
            Exit For
        End If
    Next
   
    ejAfleveretNavne = ""
Rem gennemgang af de aktuelle ark
    With ActiveSheet
        For ræk = startRæk To slutRæk
Rem Er elev-navn udfyldt
            If .Cells(ræk, 2) <> "" Then
Rem Test af checkboks i kolonne E
                Set sh = ActiveSheet.Shapes("Check Box " & CStr(cbNr))
                sh.Select
                værdi = Selection.Value
Rem check om opgave afleveret, hvis værdi=1 er afleveret
                If værdi <> 1 Then
                    ejAfleveretNavne = ejAfleveretNavne + .Cells(ræk, 2) + vbCr
                End If
            End If
            cbNr = cbNr + 1
    Next ræk
    End With
   
Rem Check om der er elever, der ikke har afleveret - hvis mindst een - send mail
    If ejAfleveretNavne <> "" Then
        afSendMail ejAfleveretNavne
    End If
   
    Application.ScreenUpdating = True
End Sub
Private Function udskilNr(cbnavn)
Dim nr
    For p = Len(cbnavn) To 1 Step -1
        tegn = Mid(cbnavn, p, 1)
        If tegn = " " Then
            udskilNr = Mid(cbnavn, p + 1)
            Exit Function
        End If
    Next p
End Function
Private Sub afSendMail(navne)
Dim mailApp, Namespace, indbakke, nyMail, nyAtt
Dim modtager, emne, vedhft, body

    modtager = mailModtager
    emne = mailEmne
    body = navne + mailAfslutning
   
    On Error GoTo sendMailFejl
   
Rem Opsætning af Outlook
    Set mailApp = CreateObject("Outlook.Application")
    Set Namespace = mailApp.GetNamespace("MAPI")
    Set indbakke = Namespace.GetDefaultFolder(olFolderInbox)

    Set nyMail = mailApp.CreateItem(olMailItem)
    Set nymod = nyMail.Recipients

    nymod.Add modtager
    nyMail.Subject = emne
    nyMail.body = body
    nyMail.Display
    Exit Sub
   
sendMailFejl:
    Stop
End Sub