Ich habe eine Code der mir bei Termineingabe Spieltermine in den Outlook Kalender schreibt.
Das funktioniert einwandfrei, bei diesem Code ist es so das die Terminuhrzeit immer auf 18:00 Uhr ist.
Spieltermin trage ich immer in die Spalte G ein, Betreff ist von Spalte C und Spalte E.
Ich hätte gerne wenn ich in Spalte I eine Uhrzeit eintrage das diese im Outlook so übernommen wird.
Vielen Dank für eure Hilfe
Hier der Code
Option Explicit
Sub sbCreateAppM(ByVal zeile As Long, ByVal spalte As Long)
Dim lobjOutl As Object, ldtAppM As Date, lboExist As Boolean
Dim lobjNS As Object, lobjAppmFolder As Object, lobjAppMs As Object, lobjAppM As Object
Set lobjOutl = CreateObject("Outlook.Application")
Set lobjNS = lobjOutl.GetNamespace("MAPI")
Set lobjAppmFolder = lobjNS.GetDefaultFolder(9) 'olFolderCalendar
ldtAppM = Cells(zeile, spalte).Value
Set lobjAppMs = lobjAppmFolder.Items.Restrict("[Start] >= '" & Format(ldtAppM, "dd""/""mm""/""yyyy hh:nn") & "' and [Start] = '" & Format(ldtAppM + 1, "dd""/""mm""/""yyyy hh:nn") & "'")
For Each lobjAppM In lobjAppMs
If Year(lobjAppM.Start) = Year(ldtAppM) Then
If lobjAppM.Subject = Cells(zeile, 3).Value & " vs " & Cells(zeile, 5) & Cells(zeile, 9).Value Then
lboExist = True
Exit For
End If
End If
Next
If lboExist = False Then
Set lobjAppM = lobjOutl.CreateItem(1)
With lobjAppM
.Subject = Cells(zeile, 3).Value & " vs " & Cells(zeile, 5).Value
.Start = Format(Cells(zeile, spalte).Value, "dd.mm.yyyy") & " 18:00" 'Uhrzeit anpassen
.End = Format(Cells(zeile, spalte).Value, "dd.mm.yyyy") & " 18:00" 'Uhrzeit anpassen
.Save
End With
End If
End Sub