verzenden mail

[wacco]

Ik gebruik voor het verzenden van email vanuit excel, deze code.

ub Mail_ActiveSheet()

    Dim OutApp As Object
    Dim OutMail As Object
    Dim strto As String
    Dim strbody As String
    Dim cell As Range
    
   

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

   

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

   
        With OutMail
            For Each cell In ThisWorkbook.Sheets("Planning").Range("M8:M20")
                If cell.Value Like "?*@?*.?*" And LCase(cell.Offset(0, 1).Value) = "yes" Then
                    If strto = "" Then strto = stro & ";"
                    strto = strto & cell.Value & ";"
                End If
            Next cell
            
            .To = strto
            .CC = ""
            .BCC = ""
            .Subject = Range("O4").Value
            For Each cell In ThisWorkbook.Sheets("Planning").Range("O8:O12")
        strbody = strbody & cell.Value & vbNewLine
    Next
             .Body = strbody
             .Display
             '.Send
            
        End With
        On Error GoTo 0


    Set OutMail = Nothing
    Set OutApp = Nothing

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

Deze code heb ik eerder op dit forum gevonden en aangepast.

Echter als ik direct wil verzenden, dus zonder display, krijg ik een foutmelding.

             .Body = strbody
             '.Display
             .Send

Foputmelding :


Weet iemand, wat ik fout doe.
Ik wil graag de mail direct verzenden, zonder eerst te bevestigen

Gr,

 

[edmoor]

Deze doet het bij mij goed. Zorg er wel voor dat je in de cel direct rechts van de email adressen (Kolom N) het woordje yes hebt staan bij minimaal 1 adres.

Sub Mail_ActiveSheet()

    Dim OutApp As Object
    Dim OutMail As Object
    Dim strto As String
    Dim strbody As String
    Dim cl As Range

    For Each cl In ThisWorkbook.Sheets("Planning").Range("M8:M20")
        If cl.Value Like "?*@?*.?*" And LCase(cl.Offset(0, 1).Value) = "yes" Then
            If strto = "" Then strto = stro & ";"
            strto = strto & cl.Value & ";"
        End If
    Next cl
    
    For Each cl In ThisWorkbook.Sheets("Planning").Range("O8:O12")
        strbody = strbody & cl.Value & vbNewLine
    Next cl
    
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
   
    With OutMail
        .To = strto
        .CC = ""
        .BCC = ""
        .Subject = Range("O4").Value
        .Body = strbody
        '.Display
        .Send
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing

End Sub

Verschillende zaken heb ik op een logische plek gezet en overbodige dingen eruit gehaald.
Tevens de variabele cell gewijzigd in cl.
Gebruik geen correct Engelse woorden als variabele en zeker niet als het de naam van een standaard Excel object betreft.

 

[wacco]

Blijft nog steeds de fout geven, op het moment dat de code bij Send komt.
Vanavond eens op een ander systeem testen, kijken wat daar gebeurt.

Gr,

 

[edmoor]

Plaats anders je document eens.

 

[wacco]

Staat wat gevoelige info in.
Is beter om dit niet op te sturen.

Zal eerst eens proberen op een ander systeem.
Laat het in ieder geval weten, of het daar op werkt.

gr,

 

[wacco]

Werkt daar ook niet.
Maar laat het voorlopig zo.
Eigenlijk is het eerst controleren van de te verzenden mails, wel handig

Bedankt voor de hulp, sluit dit draadje af.

Gr,