E-Mail Automatisierung Funktioniert nur bis zur zweiten E-Mail.

[eric_]

Diese E-Mail Automatisierung hat bereits Funktioniert nur seit heute kann ich maximal zwei E-Mails versenden.

Code:

Sub Senden()

Dim ol As Outlook.Application
Dim olm As Outlook.MailItem

Dim wd As Word.Application
Dim doc As Word.Document



Set ol = New Outlook.Application

For r = 5 To Tabelle1.Cells(Rows.Count, 1).End(xlUp).Row
    Set olm = ol.CreateItem(olMailItem)
   
   
   
    Set wd = New Word.Application
    wd.Visible = True
    Set doc = wd.Documents.Open(Cells(2, 2).Value)
   
    With wd.Selection.Find
        .Text = "<<Wort1>>"
        .Replacement.Text = Tabelle1.Cells(r, 1).Value
        .Execute Replace:=wdReplaceAll
    End With
   
      With wd.Selection.Find
        .Text = "<<Wort2>>"
        .Replacement.Text = Tabelle1.Cells(r, 2).Value
      .Execute Replace:=wdReplaceAll
  End With
 
 
   With wd.Selection.Find
        .Text = "<<Wort3>>"
        .Replacement.Text = Tabelle1.Cells(r, 3).Value
      .Execute Replace:=wdReplaceAll
  End With
 
  doc.Content.Copy
 
   
With olm
.Display
.To = Tabelle1.Cells(r, 14).Value
.Subject = Tabelle1.Cells(r, 15).Value



Set Editor = .GetInspector.WordEditor
Editor.Content.Paste
.Send

End With
   
Set olm = Nothing

doc.Close SaveChanges:=False
Set doc = Nothing
Application.DisplayAlerts = False

wd.Quit
Set wd = Nothing
Application.DisplayAlerts = True

Next

End Sub

 Der Fehler Tritt bei der line doc.Close SaveChanges:=False auf.
"Laufzeitfehler '462'
Der remote server computer existiert nicht oder ist nicht verfügbar."
Meine Vermutung ist das dies entsteht weil Word vor dem Schließen dies abfragt:

Möchten Sie dieses letzte Element, das Sie kopiert haben beibehalten?
Wenn Ja kann das Länger dauern.

In meiner Recherche habe ich keinen weg gefunden dies Entweder in Word abzustellen oder in VBA zu verneinen.
Weiß irgendjemand wie ich diesen Code wieder zum Laufen bringe?
Viele Grüße und Dank,
Eric Husmann

[steve1da]

Hola,

https://www.clever-excel-forum.de/misc.php?action=help&hid=10
Bitte nachholen.

Gruß,
steve1da

[Der Steuerfuzzi]

Ich mach das mal:
https://www.office-hilfe.com/support/thr...ail.55231/

[volti]

Hallo Eric,

wenn es an der Abfrage liegt und niemand eine bessere Lösung weiß, könntest Du die Dialogbox einfach wegklicken.

Da der Code bei bei der Anzeige der Dlg ja nicht weiterläuft und auf eine Antwort wartet, kann man das mit etwas API-Gedöns lösen.

Teste mal folgenden Ansatz.... (Vorher den genauen Captiontext der Dialogbox im Code anpassen)

Code:

Option Explicit

Private Declare PtrSafe Function KillTimer Lib "user32" ( _
        ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
Private Declare PtrSafe Function SetTimer Lib "user32" ( _
        ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr, _
        ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
Private Declare PtrSafe Function SendDlgItemMessageA Lib "user32" ( _
        ByVal hDlg As LongPtr, ByVal nIDDlgItem As Long, _
        ByVal wMsg As Long, ByVal wParam As LongPtr, _
        ByVal lParam As LongPtr) As LongPtr
Private Declare PtrSafe Function FindWindowA Lib "user32" ( _
        ByVal lpClassName As String, _
        ByVal lpWindowName As String) As LongPtr

Dim hTimer As LongPtr

Private Sub DlgClickProc()
' Klickt den Nein-Button an
  Dim hDlg As LongPtr
  
' <<<<Hier den Captiontext der Dlg einsetzen>>>>
  hDlg = FindWindowA("#32770", "Dokument wird verwendet")
  If hDlg > 0 Then SendDlgItemMessageA hDlg, 2, &HF5, 0&, 0&  '6=ja, 2=nein

End Sub


Sub Senden()
  Dim ol As Outlook.Application
  Dim olm As Outlook.MailItem
' Code....
 
  Set olm = Nothing

' Dialogbox wegklicken
  hTimer = SetTimer(0&, 0&, 50, AddressOf DlgClickProc)
  doc.Close SaveChanges:=False
  KillTimer 0&, hTimer

  Set doc = Nothing
' Code....

End Sub

_________
viele Grüße
Karl-Heinz