VBA Emailversand aus Userform
01.08.2019 15:14:01
Andreas
für ein Projekt benötige ich aus einer Userform eine automatische Email.
Abgesendet soll diese beim Bestätigen der Userform werden, wenn zwei TextBoxen befüllt sind.
Meine Überprüfung (programmiert in der Userform unter Command Button1)
If (NeuerFehler > 0) And NeuerFehler.Text "" Then
Call SendNotesMailneuerFehler
End If
End Sub Der Befehl für den Emailversand ist programmiert in diese Arbeitsmappe
Private Sub SendNotesMailneuerFehler()
Dim wks As Worksheet: Set wks = ActiveSheet
Dim Maildb As Object
Dim MailDoc As Object
Dim session As Object
Dim Recipient As Variant
Dim Signature As String
Dim rtitem
Dim EmbedObj As Object
Dim AttachME As Object
Set session = CreateObject("Notes.NotesSession")
Set Maildb = session.CURRENTDATABASE
Set MailDoc = Maildb.CREATEDOCUMENT
Recipient = Worksheets("Jahres?bersicht").Range("j3").Value
MailDoc.Form = "Memo"
MailDoc.sendto = Recipient
MailDoc.CopyTo = Worksheets("Jahres?bersicht").Range("j4").Value & ", " & Worksheets("Jahres? _
bersicht").Range("j5").Value
MailDoc.Subject = "neuer Fehler von " & wks.Cells(3, 5) & " " & wks.Cells(4, 5) & " _
festgestellt"
Signature = Maildb.GETPROFILEDOCUMENT("CalendarProfile").GETITEMVALUE("Signature")(0)
Set rtitem = MailDoc.CREATERICHTEXTITEM("Body")
With rtitem
.APPENDTEXT ("Ein Neuer Fehler des Bauteils " & wks.Cells(3, 5) & " " & wks.Cells(4, 5) & " _
wurde gefunden. Es wurden" & NeuerFehler & "mal" & NeuerFehler.Text & "festgestellt")
.ADDNEWLINE (2)
Call .EMBEDOBJECT(1454, "", "C:\Eigene Dokumente\Makro\Test1.xls")
.ADDNEWLINE (2)
.APPENDTEXT Signature
End With
MailDoc.SAVEMESSAGEONSEND = True
MailDoc.PostedDate = Now()
MailDoc.SEND 0, Recipient
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set session = Nothing
Set EmbedObj = Nothing
End Sub
Da ich noch kein VBA Profi bin gehe ich davon aus, dass ich etwas grundlegend falsch mache.
Evtl. kann mir ja jemand weiterhelfen.