Clever-Excel-Forum

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

Hola,

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

Gruß,
steve1da

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

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

eric_

steve1da

Der Steuerfuzzi

volti