Dateiversand per E-Mail und Outlook
21.10.2021 15:11:12
Obsi
nachstehendes Makro funktionierte 2 Jahre ohne Probleme, jetzt hat die Firma Office 2019 (hier geht es um Excel und Outlook) und ein Update auf eine neuer Windowsversion und es hängt sich auf.
Den Nutzern wird ein mit VBA gesteuertes Workflow-Eingabeformular zur Verfügung gestellt, wenn die fertig sind, klicken die auf "Versenden", aus der Bearbeitungsdatei werden alle für mich nötigen Informationen in eine neue Excel-Datei kopiert und diese dann per Application.Dialogs(xlDialogSendMail).Show in eine E-Mail eingebettet, Betreff und Empfänger sind auch vorgegeben, nur senden soll der Nutzer selbst. Die Datei wird dann als Mappe?.xlsx verschickt ohne irgendwo vorher gespeichert worden zu sein. Wie gesagt bisher ging das auch problemlos mit Outlook (und vorher Lotus Notes) und Excel 2017.
Jetzt kommt in Outlook der Hinweis Die Datei kann nicht gefunden werden. Überprüfen Sie den Pfad und den Dateinamen. und in Excel Laufzeitfehler 1004 (Allgemeiner E-Mail-Fehler). Der Debugger bleibt in der Zeile Application.Dialogs(xlDialogSendMail).Show[...] stehen.
Das Paradoxe, wenn ich das Makro beende und ein neues Makro ausschließlich mit dem Befehl Application.Dialogs(xlDialogSendMail).Show ausführe, bettet er die Datei in die Mail ein - ohne Fehler. Der VBA befehl ist ja derselbe, wie auf den E-Mail Button in Excel klicken, auch das geht ohne Probleme. Nur eben nicht, wenn der andere Code vorher abgearbeitet wurde.
Jemand ne Idee was das sein kann und ich das beheben kann?
Sub Versenden()
Dim Timestamp As String
Dim Absender As String
Dim Betreff As String
'On Error GoTo Error
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Workbooks.Add
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="XY"
ActiveSheet.EnableSelection = xlUnlockedCells
'Timestamp = ActiveSheet.Cells(2, 13) 'Z,S
Timestamp = Format(Date, "YYYYMMDD") 'NEU
Absender = ActiveSheet.Cells(2, 12) 'Z,S
'Betreff = "Korrekturmeldung von " & Absender & " // Timestamp: " & Timestamp
Betreff = Timestamp & "_Korrekturmeldung von " & Absender 'NEU
Application.Dialogs(xlDialogSendMail).Show 'arg1:="ich", arg2:=Betreff
ActiveWindow.Close savechanges:=False 'Versanddateie
ActiveWorkbook.Close savechanges:=False 'diese Datei
Exit Sub
Error:
MsgBox "Die Korrektur kann nicht versendet werden!" & vbCrLf & vbCrLf _
& "- E-Mail Programm offen?" & vbCrLf _
& "- Keine Popup-Meldungen offen?" & vbCrLf & vbCrLf _
& "- ggf. manuell Melden.", vbOKOnly, "Versand nicht möglich."
Exit Sub
End Sub