Send regneark, hvis betingelse er opfyldt

Det kommer lidt an på hvilket mailprogram, du bruger.

Jeg bruger Outlook

Du kan se en løsning med Outlook hos Ron de Bruin

http://www.rondebruin.nl/win/s1/outlook/amail1.htm

Tilføj lige efter Dim sætningerne

If Range("c5").Value <= then exit sub

Under .to skal du rette til Range("A1").value. Det hele skal se sådan ud:

Sub Mail_workbook_Outlook_1()
'Working in Excel 2000-2016
'This example send the last saved version of the Activeworkbook
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
    Dim OutApp As Object
    Dim OutMail As Object

    If Range("c5").Value <= 10 Then Exit Sub

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
    With OutMail
        .to = Range("a1").value
        .CC = ""
        .BCC = ""
        .Subject = "This is the Subject line"
        .Body = "Hi there"
        .Attachments.Add ActiveWorkbook.FullName
        'You can add other files also like this
        '.Attachments.Add ("C:\test.txt")
        .Send  'or use .Display
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

Der sker ingenting, og jeg får ingen fejl. Mystisk
Jeg har ændret "send" til "Display", men det sker der heller ikke noget ved.

Jeg skal aktivere macro manuelt. Den starter ikke automatisk når celle C5 er større end 10. Når jeg aktiverer den manuelt, fungerer den som den skal.

Macroen skal køre hver gang indholdet i en tilfældig celle ændres, så vil jeg tro det virker. Hvordan får jeg den så til det :-)

Hvis den skal køre automatisk, kal den ændres lidt. I så fald skal den lægges arkets kodemodul (højreklik på arkfanen og vælg Vis kode), og se ud som følger:


Private Sub Worksheet_Change(ByVal Target As Range)
    Dim OutApp As Object
    Dim OutMail As Object
   
    If Not Intersect(Target, Range("c5")) Is Nothing Then
        If Target.Value <= 10 Then Exit Sub

            Set OutApp = CreateObject("Outlook.Application")
            Set OutMail = OutApp.CreateItem(0)

            On Error Resume Next
            With OutMail
                .to = Range("a1").Value
                .CC = ""
                .BCC = ""
                .Subject = "This is the Subject line"
                .Body = "Hi there"
                .Attachments.Add ActiveWorkbook.FullName
                'You can add other files also like this
                '.Attachments.Add ("C:\test.txt")
                .Send  'or use .Display
            End With
        On Error GoTo 0

        Set OutMail = Nothing
        Set OutApp = Nothing
  End If
End Sub

Det virker, takker :-)

Velbekomme...