Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1924to1928
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Mailversand über VBA - Fehlermeldung

Mailversand über VBA - Fehlermeldung
24.03.2023 13:08:57
Georg

Liebe Mitglieder
der Code ist Teil einer Userform.
Es sollen Daten versendet werden, die vorher über die Userform schon ausgewählt wurden und in ein Tabellenblatt kopiert wurden.
BISHER unter Office2013 hat es einwandfrei funktioniert.
SEIT wir O365 haben passiert folgendes.
Die Mail geht zwar auf, aber
a) es fehlen die Daten aus dem Tabellenblatt
b) wenn ich auf "Senden" klicke kommt die Meldung: Laufzeitfehler2147467259(80004005)Fehler beim Ausführen der Operation.
Der Code bleibt in dieser Zeile stehen: With .GetInspector.WordEditor.Application.Selection
Jetzt bin ich nicht der Oberschlaue, was Mailversenden etc angeht, heißt ich habe den Code im Netz gefunden und etwas an unsere Bedürfnisse angepasst.
Ein Tipp wie immer wäre prima ! Vielen Dank Georg



Private Sub CommandButton1_Click()

'Kontoanlage Mail
Dim sMailtext As String, EndeTicket1 As Range
Dim sendFrom As String
Dim outapp As Object

With ThisWorkbook.Worksheets(Sheets.Count)
Set EndeTicket1 = .Columns(2).Find(what:="EndeTicket1")
If Not EndeTicket1 Is Nothing Then
.Range(.Cells(1, 2), .Cells(EndeTicket1.Row - 1, EndeTicket1.Column)).Copy 'Nur Spalte B wird kopiert wg. Darstellung in freshService
Else
MsgBox "Kein Keyword gefunden!", vbCritical, "Mail senden"
Exit Sub
End If
End With

Set outapp = CreateObject("Outlook.Application")
sendFrom = outapp.Session.Accounts.Item(1).SmtpAddress


sMailtext = "Hallo zusammen," & vbCrLf & _
"bitte legen Sie ab dem unten aufgeführten Eintrittsdatum für folgende MitarbeiterIn ein Benutzerkonto an." & vbCrLf & _
"Bitte den Benutzernamen und Account an folgende Mail-Adresse senden: " & sendFrom & vbCrLf & _
"Die Passwörter sind pro neuem Benutzerkonto unterschiedlich anzulegen und müssen den jeweils aktuellen Passwortrichtlinien entsprechen." & vbCrLf & _
"Die Berechtigungen Verteiler, Durchwahl und Positionsbezeichnung sind wie folgt einzurichten." & vbCrLf & _
"Vielen Dank." & vbCrLf & vbCrLf & _
"Mit freundlichen Grüßen!"


With CreateObject("Outlook.Application").CreateItem(0)
.GetInspector
.To = "support@gedikomservicedesk.freshservice.com"
.CC = ""
.BCC = ""
.Subject = "Konto Anlage" & " " & TxtBoxBetreffBPx.Value
.body = sMailtext & vbLf & vbLf & .body ' ggf. mit Signatur
.Display ' or use .Send

With .GetInspector.WordEditor.Application.Selection
.Start = Len(sMailtext) + 1 ' Einfügeposition ggf. anpassen
.Paste ' Bereich einfügen
End With

End With
ThisWorkbook.Worksheets(Sheets.Count).Activate
Application.CutCopyMode = False

End Sub

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Mailversand über VBA - Fehlermeldung
24.03.2023 13:29:31
onur
Was mir auffällt:
Es wird kopiert, nur wenn EndeTicket1 gefunden wurde, aber versucht einzufügen, selbst wenn nix zum Einfügen da ist, weil nix gefunden wurde - Könnte zu Fehlern führen
Der Bereich wird erst NACH dem Senden bzw Display eingefügt,


AW: Mailversand über VBA - Fehlermeldung
24.03.2023 13:31:46
onur
Sorry, Punkt 1 sttreichen - habe "Exit Sub" übersdehen.


AW: Mailversand über VBA - Fehlermeldung
24.03.2023 13:45:58
Georg
erstmal danke.
Zu 1) den Wert Ticket1 gibt es IMMER
zu 2) Habe das Einfügen verschoben

With CreateObject("Outlook.Application").CreateItem(0)
.GetInspector
und hier gleich With .GetInspector.WordEditor.Application.Selection

Fehlermeldung bleibt leider ?!


Anzeige
AW: Mailversand über VBA - Fehlermeldung
24.03.2023 13:51:22
onur
Ich meinte
Display ' or use .Send
zwischen die beiden "End With" verschieben.


AW: Mailversand über VBA - Fehlermeldung
24.03.2023 14:01:32
volti
Hallo onur,

vor dem Einfügen in den Wordeditor muss die Mail sichtbar sein, also .Display erfolgt sein.

Das ist hier der Fall. Kann m.E. nicht der Fehler sein.

Gruß KH


AW: Mailversand über VBA - Fehlermeldung
24.03.2023 13:57:47
volti
Hallo Georg,

also bei meiner MS 365 (2106 privat 64 Bit) läuft der Code tadellos durch.

Ich glaube auch nicht, dass meine kleinen Veränderungen es zum besseren wenden. Aber probiere es einfach mal aus.
Ich hatte auch schon mal den Fall, dass der code an so einer Stelle stehen blieb; leider habe ich vergessen, was der Grund war und wie ich das behoben hatte :-(

Code:


Private Sub CommandButton1_Click() 'Kontoanlage Mail Dim sMailtext As String, EndeTicket1 As Range Dim sendFrom As String Dim outapp As Object With ThisWorkbook.Worksheets(Sheets.Count) Set EndeTicket1 = .Columns(2).Find(what:="EndeTicket1") If Not EndeTicket1 Is Nothing Then On Error Resume Next Do .Range(.Cells(1, 2), .Cells(EndeTicket1.Row - 1, EndeTicket1.Column)).Copy 'Nur Spalte B wird kopiert wg. Darstellung in freshService If Err.Number = 0 Then Exit Do 'Bei Problemen Err.Clear 'mehrfach versuchen Loop On Error GoTo 0 Else MsgBox "Kein Keyword gefunden!", vbCritical, "Mail senden" Exit Sub End If End With Set outapp = CreateObject("Outlook.Application") sendFrom = outapp.Session.Accounts.Item(1).SmtpAddress sMailtext = "Hallo zusammen," & vbCrLf _ & "bitte legen Sie ab dem unten aufgeführten Eintrittsdatum für folgende MitarbeiterIn ein Benutzerkonto an." & vbCrLf _ & "Bitte den Benutzernamen und Account an folgende Mail-Adresse senden: " & sendFrom & vbCrLf _ & "Die Passwörter sind pro neuem Benutzerkonto unterschiedlich anzulegen und müssen den jeweils aktuellen Passwortrichtlinien entsprechen." & vbCrLf _ & "Die Berechtigungen Verteiler, Durchwahl und Positionsbezeichnung sind wie folgt einzurichten." & vbCrLf _ & "Vielen Dank." & vbCrLf & vbCrLf _ & "Mit freundlichen Grüßen!" With CreateObject("Outlook.Application").CreateItem(0) .GetInspector.Display .To = "support@gedikomservicedesk.freshservice.com" .CC = "" .BCC = "" .Subject = "Konto Anlage" & " " & TxtBoxBetreffBPx.Value .body = sMailtext & vbLf & vbLf & .body ' ggf. mit Signatur With .GetInspector.WordEditor.Application.Selection .Start = Len(sMailtext) + 1 ' Einfügeposition ggf. anpassen .Paste ' Bereich einfügen End With ' or use .Send End With ThisWorkbook.Worksheets(Sheets.Count).Activate Application.CutCopyMode = False End Sub

_________________________
viele Grüße aus Freigericht 😊
Karl-Heinz



Anzeige
AW: Mailversand über VBA - Fehlermeldung
24.03.2023 14:20:27
onur
Habe mal deinen Code getestet - bei mir läuft er auch problemlos durch.


AW: Mailversand über VBA - Fehlermeldung
24.03.2023 14:49:24
volti
Hallo Georg,

den Fehler (wohl temporärer Art) können wir so nicht eingrenzen.
Vielleicht mag Dein Outlook jetzt keine 2 CreateObject, also mal dieses hier einsetzen: With outApp.CreateItem(0)

Es gibt noch Alternativen, z.B. das ganze über eine HTML-Mail zu machen oder weitere Alternativen, die dann den Bereich einzig, also ohne Zusatztext einfügen.

Wenn alle Stricke reißen, gibt es letztendlich noch die RangeToHTML-Version, die über die Auskoppelung in eine temporäre Datei arbeitet.

Hier in Beispiel mit meiner Range2HTML-Version, vielleicht klappt es ja damit.

Code:


Option Explicit Private Sub CommandButton1_Click() 'Kontoanlage Mail Dim sMailtext As String, EndeTicket1 As Range Dim sendFrom As String Dim outApp As Object Dim oBer As Object With ThisWorkbook.Worksheets(Sheets.Count) Set EndeTicket1 = .Columns(2).Find(what:="EndeTicket1") If Not EndeTicket1 Is Nothing Then Set oBer = .Range(.Cells(1, 2), .Cells(EndeTicket1.Row - 1, EndeTicket1.Column)) Else MsgBox "Kein Keyword gefunden!", vbCritical, "Mail senden" Exit Sub End If End With Set outApp = CreateObject("Outlook.Application") sendFrom = outApp.Session.Accounts.Item(1).SmtpAddress sMailtext = "Hallo zusammen,¶" _ & "bitte legen Sie ab dem unten aufgeführten Eintrittsdatum für folgende MitarbeiterIn ein Benutzerkonto an.¶" _ & "Bitte den Benutzernamen und Account an folgende Mail-Adresse senden: " & sendFrom & "" _ & "Die Passwörter sind pro neuem Benutzerkonto unterschiedlich anzulegen und müssen den jeweils aktuellen Passwortrichtlinien entsprechen.¶" _ & "Die Berechtigungen Verteiler, Durchwahl und Positionsbezeichnung sind wie folgt einzurichten.¶" _ & "Vielen Dank.¶¶Mit freundlichen Grüßen!" With outApp.CreateItem(0) .GetInspector.Display .To = "support@gedikomservicedesk.freshservice.com" .CC = "" .BCC = "" .Subject = "Konto Anlage" & " " & TxtBoxBetreffBPx.Value .htmlbody = Replace(sMailtext, "", "<br>") & "<br>" & Range2Html(oBer) & "<br>" & .htmlbody ' ggf. mit Signatur" ' or use .Send End With ThisWorkbook.Worksheets(Sheets.Count).Activate Application.CutCopyMode = False Set outApp = Nothing End Sub Private Function Range2Html(oBereich As Range) As String ' Gibt den angegebenen Bereich als HTML zurück, incl.Bilder Dim sTmpDatei As String, sTmp As String, sTmpVz As String Dim iff As Integer, P As Long ' Bereich in Datei exportieren With oBereich sTmpVz = Environ$("temp") & "\" sTmpDatei = sTmpVz & Format(Now, "ddmmyy" & Int(Timer) * 10) & ".htm" .Parent.Parent.PublishObjects.Add( _ SourceType:=xlSourceRange, _ Filename:=sTmpDatei, Sheet:=.Parent.Name, _ Source:=.Address, _ HtmlType:=xlHtmlStatic).Publish Create:=True iff = FreeFile Open sTmpDatei For Input As iff Range2Html = Replace(Input(LOF(iff), iff), "align=center x:publishsource=", _ "align=left x:publishsource=") Close iff ' Feststellen, ob auch Bilder im Bereich sind P = InStr(1, Range2Html, "<link rel=File-List href=") + 26 If P > 26 Then sTmp = Mid$(Range2Html, P, InStr(P, Range2Html, "/filelist.xml") - P) Range2Html = Replace(Range2Html, sTmp, sTmpVz & sTmp) End If End With On Error Resume Next Kill sTmpDatei Kill sTmpVz & sTmp End Function

_________________________
viele Grüße aus Freigericht 😊
Karl-Heinz



Anzeige
AW: Mailversand über VBA - danke...
28.03.2023 14:46:14
Georg
an alle für die Unterstützung, ich habe noch etwas im Netz recherchiert und dann was gefunden, was den Code jetzt am Laufen hält. Verstanden habe ich es zwar nicht, aber dafür sind meine Kenntnisse einfach nicht gut genug. Gruß

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige