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