Hallo zusammen :-)
Bin schon länger bei euch im Forum unterwegs und konnte dank der tollen Beiträge oftmals mein Ziel mit einem VBA-Code erreichen.
Mein momentanes Ziel sprengt jedoch meine bisherigen, wenigen Kenntnisse in Sachen VBA.
Anforderung ist es eine Mail zu verschicken, wenn der Wert in Spalte C1=0 ist.
Des Weiteren steht der dazugehörige Empfänger in A1 und der Betreff in B1.
Zudem soll ein fixer Hyperlink im Inhalt der Mail weitergegeben werden.
Folgenden Lösungsansätze habe ich bislang gefunden, verfolgt und versucht diese auf meine Bedürfnisse anzupassen, bisher leider ohne großen Erfolg.
Lösungsansatz 1:
Hiermit wird die aktuelle Datei mit in die Mail gepackt.
Habe es nicht geschafft die Datei durch einen fixen Link zu ersetzen, welche auf die Datei leitet.
Was von Vorteil ist wenn mehrere User mit einer Datei arbeiten sollen.
Weiterhin konnte ich nur fixe Empfänger/Betreffe mitgeben.
Option Explicit
Public Sub BlattVersenden()
Dim sEmpfaenger As String
Dim sBetreff As String
Dim sInhalt As String
Dim sSaveName As String
sSaveName = Environ("UserProfile") & "\Desktop\Export.xls"
sEmpfaenger = "max.mustermann@mail.de"
sBetreff = "Testdatei"
sInhalt = "Hallo Team, " & vbCrLf & _
"hier die Mail mit Anhang. " & vbCrLf & _
"Viel Spaß beim Lesen."
KopieSpeichern sSaveName
LotusNotesMail sEmpfaenger, sSaveName, sBetreff, sInhalt
End Sub
Private Sub KopieSpeichern(Dateiname As String)
Dim aktWKB As Workbook
Dim newWKB As Workbook
Dim fromWKS As Worksheet
Dim toWKS As Worksheet
If Dir(Dateiname) <> "" Then
Kill Dateiname
End If
Set aktWKB = ActiveWorkbook
Set fromWKS = aktWKB.Worksheets("XX")
Set newWKB = Workbooks.Add(xlWBATWorksheet)
Set toWKS = newWKB.Worksheets(1)
toWKS.Name = fromWKS.Name
fromWKS.Cells.Copy
toWKS.Cells.PasteSpecial Paste:=xlPasteValues
toWKS.Cells.PasteSpecial Paste:=xlPasteFormats
newWKB.SaveAs Filename:=Dateiname, AddToMru:=False
newWKB.Close
End Sub
Private Sub LotusNotesMail(Empfaenger As String, Dateianhang As String, Betreff As String, Inhalt As String)
Dim Kopie_Empfänger As String, BlindKopie_Empfänger As String
Const EMBED_ATTACHMENT = 1454
Dim server As String, mailfile As String
Dim session As Object
Dim db As Object
Dim doc As Object
Dim rtitem As Object
Dim EmbeddedObject As Object
Set session = CreateObject("Notes.NotesSession")
server = session.GetEnvironmentString("MailServer", True)
mailfile = session.GetEnvironmentString("MailFile", True)
Set db = session.GETDATABASE(server, mailfile)
Set doc = db.CreateDocument()
doc.Form = "Memo"
doc.SendTo = Empfaenger
doc.Subject = Betreff
doc.Body = Inhalt
Set rtitem = doc.CREATERICHTEXTITEM("Anhang")
Set EmbeddedObject = rtitem.EMBEDOBJECT(EMBED_ATTACHMENT, "", Dateianhang)
doc.FROM = session.UserName
doc.SaveMessageOnSend = True
Call doc.Send(True, "")
Set doc = Nothing
Set db = Nothing
Set rtitem = Nothing
Set EmbeddedObject = Nothing
Set session = Nothing
End Sub
Finde jede Menge zur Mailgenerierung aus Outlook hinaus, jedoch leider nicht aus Lotus Notes.
Wäre mir eine sehr große Hilfe, wenn Ihr euch der Sache annehmen könntet :)
Besten Dank im Voraus!
Gruß Thomas
|