Datum aus einer Zelle Suchen und Eintragungen
21.06.2017 11:00:48
Robert
Ich habe eine große Ausbildungsliste und auch ein "Ausbildung Anmelden" Blatt.
in dem "Ausbildung anmelden" blatt habe ich eine Liste, welche sich mit klick auf "Anmelden" per Mail versendet. die Zellen "wer(c15:j15), was(c5:J5), wo(C11:J11), wann(C7:J7)" möchte ich mit dem klick welcher das blatt per mail versendet, zeitgleich auf einen anderem (Ausgeblendeten) Kalender in 3 folgenden zellen unter das jeweilige Datum eintragen(welches unter wann eingetragen wurde)
kann mir wer helfen
folgender Code ist für das senden:
Option Explicit
Public Sub BlattVersenden()
Dim sEmpfaenger As String
Dim sBetreff As String
Dim sInhalt As String
Dim sSaveName As String
Dim sInfoString As String
sSaveName = "D:\Export.xlsx"
sEmpfaenger = "XXXXXX@XXXXX.org"
sBetreff = "--->AIH Anmeldung"
sInhalt = "Folgende AIH Anmeldung wurde beantragt:" & vbCrLf & _
"öffnen Sie die Datei im Anhang. " & vbCrLf & _
"Aufnahme unmittelbar in den Dienstplan."
KopieSpeichern sSaveName
LotusNotesMail sEmpfaenger, sSaveName, sBetreff, sInhalt
Kill sSaveName
'Eine Information schreiben
sInfoString = "Datenblatt an Nutzer '" & sEmpfaenger & "' gesendet."
End Sub
Private Sub KopieSpeichern(Dateiname As String)
Dim aktWKB As Workbook
Dim newWKB As Workbook
Dim fromWKS As Worksheet
Dim toWKS As Worksheet
'Falls Ausgabedatei schon besteht löschen
If Dir(Dateiname) "" Then
Kill Dateiname
End If
Set aktWKB = ActiveWorkbook
Set fromWKS = aktWKB.Worksheets("Anmeldung")
Set newWKB = Workbooks.Add(xlWBATWorksheet)
Set toWKS = newWKB.Worksheets(1)
toWKS.Name = fromWKS.Name
fromWKS.Cells.Copy 'geändert
toWKS.Cells.PasteSpecial Paste:=xlPasteValues 'geändert
toWKS.Cells.PasteSpecial Paste:=xlPasteFormats 'geändert
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
'Auslesen der Mail-DB
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 ' Adressaten übergeben
doc.Subject = Betreff
doc.Body = Inhalt
Set rtitem = doc.CREATERICHTEXTITEM("Anhang")
Set EmbeddedObject = rtitem.EMBEDOBJECT(EMBED_ATTACHMENT, "", Dateianhang) 'Dateianhang _
mit Pfad und Dateiname überschreiben
doc.FROM = session.UserName
doc.SaveMessageOnSend = True
Call doc.Send(False, "")
Set doc = Nothing
Set db = Nothing
Set rtitem = Nothing
Set EmbeddedObject = Nothing
Set session = Nothing
End Sub