Office: (Office 2016) Excel Daten als Kalendereintrag in Outlook

Hallo zusammen,
ich habe von einem User einen Code Snippsel empfohlen bekommen um Excel Daten in Outlook zu übertragen bzw in Outlook ein Kalendereintrag vorzunehmen.
Hajo_Zi vielleicht ließt du sogar mit.

Ich habe den Code auch schon ein bisschen angepasst.

Was soll der Code am ende machen?
Ich habe ein Excel Formular erstellt was ich nehmen möchte um Urlaub zu beantragen. Wenn dieser genehmigt wird, soll der Vorgesetzte auf einen Button klicken können mit dem er den Urlaub genehmigt und gleichzeitig einen Outlook eintrag macht sowie diesen an den Antragsteller zurücksendet und zusätzlich an eine E-mail Gruppe

Das Urlaubsanfangsdatum steht in celle B11 und das ende in D11
Jetzt soll er in dem Terminkalender, der Ebenfalls zu einer Gruppe gehört dieses Datum eintragen. (die Gruppe heißt Mitarbeiter)
Zusätzlich soll eine E-mail an den Antragsteller gesendet werden sowie im CC eine person aus der Buchhaltung und die Gruppe Mitarbeiter.

Kann mir jemand die 2 Module So anpassen, dass diese das machen was ich möchte?
Insofern Datum von und Datum bis übereinstimmen, darf auch nur ein halber Tag Urlaub berechnet werden. DAzu würde im Feld E11 Vormittag oder Nachmittag stehen.


Code:

Code:

Danke für eure Unterstützung.

:)

 

Hallo Horst,

hier mal auf die Schnelle eine Idee (etwas abgewandelt zu Deiner Vorlage) zu dem gewünschten Prozess.
Kann man ja ggf. noch weiter anpassen.

Schau mal, ob's so funktioniert...

Option Explicit

Sub Urlaubsgenehmigung()
'Erstellt einen Kalendereintarg und sendet eMail
Dim oOutApp As Object, WSh As Worksheet
Dim sAnlage As String

Set WSh = Sheets("Tabelle1") 'Tabelle festlegen
Set oOutApp = CreateObject("Outlook.Application")

'Kalendereintrag generieren
With oOutApp.CreateItem(1) 'Termin-Item kreierien
.Start = Format(WSh.Range("B11").Value, "dd.mm.yyyy") & " 00:00" 'Startdatum
.End = Format(WSh.Range("D11").Value, "dd.mm.yyyy") & " 00:00" 'Endedatum
.Subject = "Urlaub: " _
& WSh.Range("J2").Value & " genehmigt" 'Betreff
.Body = "" 'Zusätzlicher Text
.Location = "" 'Ort
' .ReminderMinutesBeforeStart = 10 'Erinnerung
' .ReminderPlaySound = False 'mit Sound
' .ReminderSet = False 'Erinnerung wiederholen
.Save 'Termin speichern
End With

'eMail generieren
With oOutApp.CreateItem(0) 'Mail-Item kreieren
.To = WSh.Range("B4").Value & " at firma.de"
.CC = "buchhaltung at firma.de; mitarbeiter at firma.de"
.Subject = "Urlaubsantrag " & WSh.Range("J2").Value
.GetInspector
.Body = "Anbei befindet sich der genehmigte Urlaubsantrag." & vbCrLf & .Body
.Display 'Erstellt die Email und öffnet diese. Der Versand erfolgt anschließend manuell vom User!
sAnlage = "C:\Users\Userurlaub.xlsm" 'Anlage festlegen
If Dir$(sAnlage) <> "" Then 'Prüfen, ob ANlage vorhanden
.Attachments.Add sAnlage 'Anlage anfügen
Else
MsgBox "Datei '" & sAnlage & "' wurde nicht gefunden!", vbCritical, "eMail senden"
End If
'.Send 'Sendet die Email automatisch
End With

Set oOutApp = Nothing

End Sub
Viele Grüße aus Freigericht
Karl-Heinz

PS: Das @-Zeichen verhunzt mir hier diesen HTML-Code. Bitte entsprechend "at" dann ersetzen.

 

Hallo Horst,

warum neuen Beitrag?
Zu den makros von Ramses kann ich keine Auskunft geben.
Ramses ist selber wohl nicht mehr in den Foren.
Vielleicht Mail.
Bitte berücksichtige das Themen die Erledigt sind als Erledigt markiert werden können. Also mache es unten links mit Klick auf den Schalter "als erledigt setzen", falls Problem gelöst.
Der Zustand des Beitrages wird dann in der Übersicht angezeigt und man braucht sich diese Beiträge nicht mehr ansehen.





Meine Homepage Homeseite - Hajo's Excelseiten

 

Hi,
@Hajo_Zi na weil es ein Excel Thema ist und ich dachte, dass es hier besser aufgehoben ist. In dem Andren Beitrag habe ich ja nur gefragt wie man das Prob. lösen könnte.

@volti danke für deine Idee. Es funktioniert soweit fast :-).
Er trägt den Urlaub ein jedoch wenn ich z.b vom 01.07.-04.07.20 eintrage dann markiert er den letzten Tag (4.) im Kaleder nicht mit blau.
Der müsste auch den letzen Tag mit Markieren.
Wo kann ich den Kalender in den er schreiben soll einstellen? ER soll wie gesagt in ein Gruppen Kallender schreiben.
Und ist es möglich, das der Makro selbst schaut wo das Dokument abgelegt wurde? Also das er sich fragt wo liege ich und sich von da versendet? Falls ein User die Datei nicht unter: "C:UsersUserurlaub.xlsm" ablegt?

Ich danke euch.

 

Hallo Horst,

zu Deiner ersten Frage: Ersetze einfach beim End-Datum die 00:00-Uhr durch 23:59, dann wird auch der letzte Tag mit einbezogen.

Und ja, man kann auch die Urlaubsantragsdatei suchen lassen.....

Zu der Aktivierung eines abweichenden Gruppenkalenders kann ich Dir derzeit nicht weiterhelfen. Ich bin kein Outlook-Experte und habe als Privatier auch keinerlei Zugriff auf Gruppenkalender.
Vielleicht kann Dir da jemand anders hier noch weiterhelfen.
Oder Du suchst selbst. Z.B. Stichword GetSharedDefaultFolder usw.

Falls ich doch noch was rausfinden sollte, melde ich mich noch mal. Ist aber eher unwahrscheinlich.


Option Explicit

Dim gsAnlage As String

Sub Urlaubsgenehmigung()
'Erstellt einen Kalendereintrag und sendet eMail
Dim oOutApp As Object, WSh As Worksheet, sPfadname As String

'Startpfad für die Anlagensuche hier vorgeben
sPfadname = "C:\Users\" & Environ("Username") & "\Documents"
Set WSh = Sheets("Tabelle1") 'Tabelle festlegen
Set oOutApp = CreateObject("Outlook.Application")

'Kalendereintrag generieren
With oOutApp.CreateItem(1) 'Termin-Item kreierien
.Start = Format(WSh.Range("B11").Value, "dd.mm.yyyy") & " 00:00" 'Startdatum
.End = Format(WSh.Range("D11").Value, "dd.mm.yyyy") & " 23:59" 'Endedatum
.Subject = "Urlaub: " _
& WSh.Range("J2").Value & " genehmigt" 'Betreff
.Body = "" 'Zusätzlicher Text
.Location = "" 'Ort
' .ReminderMinutesBeforeStart = 10 'Erinnerung
' .ReminderPlaySound = False 'mit Sound
' .ReminderSet = False 'Erinnerung wiederholen
.Save 'Termin speichern
End With

'eMail generieren
With oOutApp.CreateItem(0) 'Mail-Item kreieren
.To = WSh.Range("B4").Value & "@firma.de"
.CC = "buchhaltung @firma.de; mitarbeiter @firma.de"
.Subject = "Urlaubsantrag " & WSh.Range("J2").Value
.GetInspector
.Body = "Anbei befindet sich der genehmigte Urlaubsantrag." & vbCrLf & .Body
.Display 'eMail anzeigen
gsAnlage = ""
GetFile sPfadname, "Urlaub*.xls*" 'Dateiname mit Platzhaltern möglich
If gsAnlage <> "" Then 'Prüfen, ob Anlage vorhanden
.Attachments.Add gsAnlage 'Anlage anfügen
Else
MsgBox "Datei '" & gsAnlage & "' wurde nicht gefunden!", vbCritical, "eMail senden"
End If
'.Send 'Sendet die Email automatisch
End With

Set oOutApp = Nothing

End Sub

Sub GetFile(sPathname As String, sSearchFile As String)
'Ermittelt eine Datei (incl. Platzhalter im Ordner und Unterordner
Dim oFile As Object, oDir As Object

If gsAnlage <> "" Then Exit Sub 'Suchbegriff gefunden=>raus

On Error Resume Next

With CreateObject("scripting.filesystemobject").GetFolder(sPathname)

'Ordner durchsuchen
For Each oFile In .Files
If Err = 0 Then
If oFile.Name Like sSearchFile Then
gsAnlage = sPathname & "\" & oFile.Name
Exit Sub
End If
End If
Next

'Unterordner durchsuchen
For Each oDir In .Subfolders
GetFile sPathname & "\" & oDir.Name, sSearchFile
Next

End With

End Sub
Viele Grüße aus Freigericht
Karl-Heinz

 

Danke für deine Hilfe.

Du hast mich ein ganzes Stück weiter gebracht.

Ich habe inzwischen das gefunden:
Code:

Damit wird das aktuelle Dokument als Anhang versendet also eigentlich das was ich will oder könnte ich damit Probleme bekommen?

Meine 2. Frage wäre:
Mit folgdendem Modul kopiere ich unter anderem
Das Datum von Bis und wieviel Tage Urlaub es sind.

Code:

Wie müsste die schleife aussehen, damit er wenn zeile 17 belegt 18 nimmt bzw dann weiter schaut... Ich möchte den Urlaub der genommen wurde mit dokumentieren.

 

Hallo Horst,

das mit der Anlage hätte ich Dir auch sagen und Arbeit sparen können. Da habe ich Dich wohl nicht richtig verstanden.

Möglicherweise wäre das Hochladen einer Mustermappe hier vorteilhafter gewesen.

Das gleiche gilt für das nachfolgende Makro, dass ohne Beispieldatei auch nur mustermäßig ist.
Denn es bleiben die Fragen, ob Ziel- und Quellblatt in der gleichen Datei sind (wohl eher nicht) und warum einmal Zeile 9 ansonsten aber immer Zeile 17 befüllt wird, usw.

Schau mal, ob Du mit dem u.a. Code etwas anfangen kannst....


Sub AntragLeeren()
'Trägt die Daten vom Quellblatt in die erste freie Zielblattzeile ein
Dim WSh As Worksheet, iZeile As Long

Set WSh = ActiveSheet 'Workbooks("Datei.xlsx").Sheets("Quellblatt") 'Quelltabelle angeben

With ThisWorkbook.Sheets("Tabelle1") 'Zieltabelle angeben
iZeile = .Cells(.Rows.Count, "B").End(xlUp).Row + 1 'Erste freie Zeile suchen
If iZeile < 17 Then iZeile = 17
.Cells(iZeile, "B").Value = WSh.Cells(15, "D").Value
.Cells(iZeile, "J").Value = WSh.Cells(15, "B").Value
.Cells(iZeile, "L").Value = WSh.Cells(11, "B").Value
.Cells(iZeile, "N").Value = WSh.Cells(11, "D").Value
WSh.Range("B11,D11").ClearContents 'Zellen leeren
End With

End Sub

Viele Grüße aus Freigericht
Karl-Heinz

 

Hi volti,
ja es funktioniert fast.
D15 darf nur nicht nach B17 sondern nach B9

Ich habe es in der schleife auskommentiert und
nach der schleife folgendes geschrieben:

Code:

das funktioniert nicht.
und
Code:

DAnn markiert er B9 und D15 ist gestrichelt umrandet als will er damit rechnen.
Dabei soll er doch B9 mit dem was in D15 steht ersetzn35.

Das war ganz gut so da habe ich wenigstens noch eine andere möglichkeit kennengelernt und dabei etwas gelernt :-)

Ja sie sind in einer Datei/ Zielblatt.

Anbei das Beispiel.

Ich danke dir.

 

Hallo Horst,

Dein code .Cells(9, "B").Value = WSh.Cells(15, "D").Value muss innerhalb des WITH-Bereichs stehen.
Der führende Punkt bezieht sich auf das dort angegebene Tabellenblatt.

Aber letztendlich hättest Du lediglich
.Cells(iZeile, "B").Value = WSh.Cells(15, "D").Value
in
.Cells(9, "B").Value = WSh.Cells(15, "D").Value
ändern brauchen.

Es ist ja auch keine Schleife, die mehrfach durchlaufen wird, sondern der code wird nur einmalig abgearbeitet.

PS: Wenn sich alles eh auf dem aktiven Blatt abspielt reicht auch der u.a. Code hierfür aus:




Sub AntragLeeren()
Dim iZeile As Long

iZeile = Cells(Rows.Count, "B").End(xlUp).Row + 1 'Erste freie Zeile suchen
If iZeile < 17 Then iZeile = 17
Cells(9, "B").Value = Cells(15, "D").Value
Cells(iZeile, "J").Value = Cells(15, "B").Value
Cells(iZeile, "L").Value = Cells(11, "B").Value
Cells(iZeile, "N").Value = Cells(11, "D").Value
Range("B11,D11").ClearContents 'Zellen leeren

End Sub

viele Grüße
Karl-Heinz

 

Hi danke für deine Hilfe.

In der unten stehenden Zeile musste noch B auf J geändert werden.

Jetzt funktioneirt es.
Danke für deine Hilfe!

Ich muss jetzt mal schauen wie ich die Nummer mit dem Halben Tag Urlaub am besten löse.
Kann ich mit einem MAkro prüfen ob Diffdate 0 ist und anschließend 0,5 für halben Tag wählen?

 

Hallo Horst,

halbe Tage vielleicht so:?



[+][-]Sub Urlaubsgenehmigung()
'Erstellt einen Kalendereintarg und sendet eMail
Dim oOutApp As Object, WSh As Worksheet
Dim sAnlage As String, sZeit1 As String, sZeit2 As String

Set WSh = Sheets("Tabelle1") 'Tabelle festlegen
Set oOutApp = CreateObject("Outlook.Application")

'Kalendereintrag generieren
With oOutApp.CreateItem(1) 'Termin-Item kreierien
sZeit1 = " 00:00": sZeit2 = " 23:59"
If WSh.Range("B11").Value <> "" Then
If WSh.Range("B11").Value = WSh.Range("D11").Value Then
If WSh.Range("B13").Value Like "nachmittag*" Then
sZeit1 = " 12:00": sZeit2 = " 23:59"
ElseIf WSh.Range("B13").Value Like "vormittag*" Then
sZeit1 = " 00:00": sZeit2 = " 12:00"
End If
End If
End If

.Start = Format(WSh.Range("B11").Value, "dd.mm.yyyy") & sZeit1 'Startdatum
.End = Format(WSh.Range("D11").Value, "dd.mm.yyyy") & sZeit2 'Endedatum
.Subject = "Urlaub: " _
& WSh.Range("B4").Value & " genehmigt" 'Betreff
.Body = "" 'Zusätzlicher Text
.Location = "" 'Ort
' .ReminderMinutesBeforeStart = 10 'Erinnerung
' .ReminderPlaySound = False 'mit Sound
' .ReminderSet = False 'Erinnerung wiederholen
.Save 'Termin speichern
End With

'eMail generieren
With oOutApp.CreateItem(0) 'Mail-Item kreieren
.To = WSh.Range("B4").Value & "@firma.de"
.CC = "buchhaltung@firma.de; alle@firma.de"
.Subject = "Urlaubsantrag " & WSh.Range("B4").Value
.GetInspector
.Body = "Anbei befindet sich der genehmigte Urlaubsantrag." & vbCrLf & .Body
.Display 'Erstellt die Email und öffnet diese. Der Versand erfolgt anschließend manuell vom User!

'Festlegen eines Pfades welches Dokument mitgesendet werden soll
'sAnlage = "C:\Users\Userurlaub.xlsm" 'Anlage festlegen
'If Dir$(sAnlage) <> "" Then 'Prüfen, ob Anlage vorhanden
' .Attachments.Add sAnlage 'Anlage anfügen
'Else
'MsgBox "Datei '" & sAnlage & "' wurde nicht gefunden!", vbCritical, "eMail senden"
'End If

'Aktuelles Dokument als Anlage senden
.Attachments.Add ThisWorkbook.FullName
'Lesebestätigung aus
.ReadReceiptRequested = False
'.Send 'Sendet die Email automatisch
End With

Set oOutApp = Nothing

End Sub
viele Grüße aus Freigericht
Karl-Heinz

 

Hi volti, sorry Fehler von mir, ich habe mich nicht richtig ausgedrückt.
Der Kalender Eintrag war klar. Aber mir geht es um das Excel Dokument, da ich nur 0.5 Tage Urlaub abziehen darf.
Bei datediff rechnet er 0 Tage aus und somit würde beim Resturlaub nie etwas abgezogen werden.
Weißt du was ich meine?

 

Alles klar (hoffentlich. *Smilie

Kann ich mit einem MAkro prüfen ob Diffdate 0 ist und anschließend 0,5 für halben Tag wählen?

Da sollte es kein Problem geben. Allerdings müsste das mit dem Eintrag "Vormittag/Nachmittig" gegengecheckt werden.
Denn es kann bei gleichem Datum (DateDiff=0) doch auch ein ganzer Tag Urlaub geommen worden sein.

VG KH

 

Hi,
es will einfach nicht ganz klappen....

Ich habe jetzt bei B16 ein Drop Down Menü erstellt Ganztägig, Vormittag und Nachmittag.
Zusätzlich habe ich Datedif in V5 gepackt.

Code:

Das Funktioneirt aber nicht.
Wenn der zeitraum größer 0 ist, ist alles gut,
Wenn der Zeitraum 0 ist Ganztägig wird keine 1 in B16 geschrieben.
Bei "Vormittag" und "NAchmittag" wird auch keine 0,5 geschrieben.

Ich habe einen Rechtsklick auf das Tabellenblatt gemacht "Code hinzufügen" und dann den Code da rein geschrieben.

Es ist alles nochmal eine Zeile nach Unten gerutscht :-).

Ich hoffe es ist nur ein kleiner flüchtigkeitsfehler aber ich komme nicht drauf. :-(

 

So funktioniert es:
Code:

Die Meldung in der MassageBox funktioniert nur noch nicht.
JEtzt überschreibt er mir auch die Formel in B16 :-( und bei Felder leeren schreibt er immer 1 statt 0,5.