Zusammenspiel Excel-Outlook funktioniert manchmal nicht

[yogi44]

Hallo allerseits

aus Excel verschicken wir mit VBA Mails mit Outlook. Meistens gehts, ab und zu bleibt das Excelmakro stehen. Dann hilft nur noch abschiessen. Was kann da der Grund sein?

Der Code sieht so aus:

Code:

Sub setup_mail()
  '
  ' hier wird der Mailtext zusammengesetzt
  '
  ' ....
  ' ....
  '
  ' dann erfolgt der Aufruf zum Senden des Mails
  '
  Call send_email_outlook
  '
  ' Der Benutzer muss einen expilziten Sende-Befehl in Outlook geben. Er kann aber auch das Mail löschen und nicht senden.
  ' Daher wird gefragt:
  '
  answer = MsgBox("Auftragsmail gesendet?", vbYesNo, "Auftragsmail")

End Sub

Sub send_email_outlook()
  Dim mia_account_nr As Long
  Dim MiA As String
  Dim i As Long
  Dim res As Boolean
  Dim answ As Long
  '
  '
  ' Outlook
  '
  On Error Resume Next
  Set objOutlook = GetObject(, "Outlook.Application")
  '
  Err.Clear
  '
  On Error GoTo exsub
  '
  If objOutlook Is Nothing Then
    Set objOutlook = CreateObject("Outlook.Application")
  End If '  objOutlook Is Nothing
  '
  Err.Clear
  On Error GoTo 0
  '
  Set objMailItem = objOutlook.CreateItem(OutLookMailItem)
  '
  '   Suche Mia Konto
 '
  mia_account_nr = 0
  MiA = "MIA@GMX.CH"
  For i = 1 To objOutlook.Session.Accounts.Count
    '        MsgBox OutApp.Session.Accounts.Item(I)
    If Left(UCase(objOutlook.Session.Accounts.Item(i)), 25) = MiA Then
      mia_account_nr = i
      Set objOutlookAccount = objOutlook.Session.Accounts.Item(mia_account_nr)
    End If '  Left(UCase(objOutlook.Session.Accounts.Item(i))
  Next i '  i = 1 To objOutlook.Session.Accounts.Count
 
  If mia_account_nr = 0 Then
    answ = MsgBox("Konto " & MiA & " nicht gefunden", vbCritical + vbOKOnly, "Mailaccount")
   Exit Sub
  End If '  mia_account_nr = 0
  '
  strBody0 = ""
  With objMailItem
    orgbody = .htmlBody
    '
    '
    .To = strToAddress
    .cc = "Mia@gmx.ch"
    '
    .Subject = strSubject
     strBody = strBody0 + strBody
    .htmlBody = strBody + orgbody
    .BodyFormat = 2
    '
    On Error Resume Next '08.12.2016
    .Display True '08.12.2016  TRUE und Dis
    '
    res = objMailItem.Sent
    '
  End With '  objMailItem
  '
  Set objMailItem = Nothing
  Set objOutlookAccount = Nothing
  '    Set objNameSpace = Nothing
  Set objOutlook = Nothing
  Err.Clear
  On Error GoTo 0
  Exit Sub
  '
exsub:
  MsgBox "Fehler in Routine: Kein Mail erstellt, sorry. Evtl. Mailadresse falsch?  Bitte benachrichtige den Administrator"
  Err.Clear
  On Error GoTo 0
End Sub

Die Anweisung  "Call send_mail_outlook" wird ausgeführt und das Mail erscheint in Outlook. Doch nach dem Senden bleibt das Programm hängen und die
Frage

Code:

answer = MsgBox("Auftragsmail gesendet?", vbYesNo, "Auftragsmail")

wird nicht ausgeführt. Wo klemmt es???

Das Program läuft mit Excel 2010, 2013, 365 auf W7 und W10. Eine eindeutige Zuordnung zu den verschiedenen Kombinationen lässt sich nicht machen.

Gruss
yogi

[schauan]

Hallöchen,

wird das Senden wirklich automatisch ausgeführt oder musst Du im Outlook senden drücken?
Passiert der Fehler egal ob Du Outlook manuell nach dem Senden beendest oder offen lässt?
Um den "Absturzpunkt" genauer einzugrenzen könntest Du z.B. in Excel in der Statuszeile mehrere Statusmeldungen ausgeben.

[yogi44]

Tach André

da die Mails oft noch vor dem Senden editiert werden, müssen sie in Outlook per "Senden" abgeschickt werden.
Outlook wird nicht geschlossen.
Die beiden Codezeilen "Call send_email_outlook" und "answer=Msgbox..." folgen direkt aufeinander.

Code:

Call send_email_outlook
'
answer = MsgBox("Auftragsmail gesendet?", vbYesNo, "Auftragsmail")

Wie schon erwähnt, auf ein und demselben Rechner funktioniert es einige Male hintereinander und dann klemmt es plötzlich.

Gruss
yogi