Hallo zusammen.
Ich habe einen Projektplan und bestimmte Zellen mit Datum werden aktuell in mein OUtlook Kalender übertragen. Allerdings setzt der Termin auf 00:05 Uhr. Ich hätte ihn gerne ganztägig und finde dazu leider keine Lösung. Ich bitte um Hilfe bei ERgänzung des Codes:
Sub Projektannahme_Klicken()
Dim OutApp As Object, ApptOutApp As Object
ActiveSheet.Range("J22").Select
Set OutApp = CreateObject("Outlook.Application")
Set ApptOutApp = OutApp.CreateItem(1) 'olAppointmentItem
With ApptOutApp
.Start = Format(ActiveCell.Value, "dd.mm.yyyy") '& "08.00"
.Subject = "Projektplan " & ActiveSheet.Range("D4 ") & ActiveSheet.Range("B22 ") 'ActiveCell.Offset(0, -7)
.Body = ActiveSheet.Name
.Location = "Büro"
.Duration = "5"
.ReminderMinutesBeforeStart = 10
.ReminderPlaySound = True
.ReminderSet = True
.Save
End With
MsgBox "Termine übertragen"
End Sub
Danke!
|