Fout bij verzenden e-mail

[Jos1234]

Beste
Het bestand in bijlage geeft een foutmelding als de lus de 2e keer wordt doorlopen bij het verzenden van een e-mail.
Bekijk bijlage foutmelding.bmp

Ik gebruik deze VBA-code

Sub SendEmail()

Dim Subj As String, Mesg As String, EmailAdd As String
Dim LaatsteRij As Long

LaatsteRij = Blad1.Range("C9999").End(xlUp).Row

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

If Range("i3").Value = Empty Then
    MsgBox "Je hebt geen onderwerp ingegeven!"
    Exit Sub
Else
    Subj = Range("i3").Value
End If

Mesg = txtInhoud.Value

For x = 3 To LaatsteRij
    If Range("A" & x).Value = True Then
       EmailAdd = Range("D" & x).Value

       With OutMail
        .to = EmailAdd
        .Subject = Subj
        .Body = Mesg
        .Send 
       End With
       EmailAdd = ""
    End If
Next x

Set OutMail = Nothing
Set OutApp = Nothing

End Sub

Wat is er mis?
Jos

 

[edmoor]

Waarschijnlijk gaat het te snel.
Maak er eens dit va:

For x = 3 To LaatsteRij
    If Range("A" & x).Value = True Then
       EmailAdd = Range("D" & x).Value

       With OutMail
        .to = EmailAdd
        .Subject = Subj
        .Body = Mesg
        .Send 
       End With
       EmailAdd = ""
    End If
[COLOR="#FF0000"]    DoEvents[/COLOR]
Next x

 

[VenA]

Of de code een beetje anders opzetten.

Sub VenA()
Dim j As Long, c00 As String, ar
  With Blad1
    ar = .UsedRange
    c00 = .txtInhoud.Value
    If Len(Trim(ar(3, 9))) = 0 Then
      MsgBox "Je hebt geen onderwerp ingegeven!"
      Exit Sub
    End If
  End With
  
  For j = 3 To UBound(ar)
    If ar(j, 1) Then
      With CreateObject("Outlook.Application").CreateItem(0)
        .To = ar(j, 4)
        .Subject = ar(3, 9)
        .Body = c00
        .display 'Send or Display
      End With
    End If
  Next j
End Sub

 

[Jos1234]

Of de code een beetje anders opzetten.

Sub VenA()
Dim j As Long, c00 As String, ar
  With Blad1
    ar = .UsedRange
    c00 = .txtInhoud.Value
    If Len(Trim(ar(3, 9))) = 0 Then
      MsgBox "Je hebt geen onderwerp ingegeven!"
      Exit Sub
    End If
  End With
  
  For j = 3 To UBound(ar)
    If ar(j, 1) Then
      With CreateObject("Outlook.Application").CreateItem(0)
        .To = ar(j, 4)
        .Subject = ar(3, 9)
        .Body = c00
        .display 'Send or Display
      End With
    End If
  Next j
End Sub

Dit werkt perfect.
Bedankt

 

[Jos1234]

Waarschijnlijk gaat het te snel.
Maak er eens dit va:

For x = 3 To LaatsteRij
    If Range("A" & x).Value = True Then
       EmailAdd = Range("D" & x).Value

       With OutMail
        .to = EmailAdd
        .Subject = Subj
        .Body = Mesg
        .Send 
       End With
       EmailAdd = ""
    End If
[COLOR="#FF0000"]    DoEvents[/COLOR]
Next x

Ik blijf hiermee dezelfde foutmelding ontvangen?

 

[edmoor]

Ok, was een gokje