VBA Termine in Outlook übertragen mit Startdatum

[croap]

Hallo zusammen!

Als neuer User dieses Forums bin ich mir nicht sicher, ob ich hierfür einen neuen Thread erstellen muss. Bitte verschiebt ihn wenn nötig.

Ich habe mir einen Code "zusammengegoogelt", bei dem ich einen oder mehrere Termine von Excel nach Outlook übertragen kann.
Primäres Problem: ich bekomme keine Startzeit hin. Alle Codes die ich gefunden habe, starten an einer fest definierten Zeit:

Code:

Sub Outlook()


Dim wksSheet As Worksheet
    Dim objFolder As Object
    Dim objOutApp As Object
    Dim objTermin As Object
    Dim lngRow As Long
    Const olMeeting = 1
    On Error GoTo Fin
    Set wksSheet = ThisWorkbook.Worksheets("Neue Termine")
    Set objOutApp = CreateObject("Outlook.Application")
    Set objFolder = objOutApp.GetNamespace("MAPI").GetDefaultFolder(9) '9 = olFolderCalendar
    For lngRow = 4 To wksSheet.Cells(Rows.Count, 1).End(xlUp).Row
        If Not fncPointExist(objFolder, wksSheet.Cells(lngRow, 3).Value) And _
            IsDate(wksSheet.Cells(lngRow, 1).Value) Then
            Set objTermin = objOutApp.CreateItem(1)
            With objTermin
                .Start = Format(wksSheet.Cells(lngRow, 1).Value, "dd.mm.yyyy") & " 10:00"
                .Subject = wksSheet.Cells(lngRow, 3).Value
                .Body = wksSheet.Cells(lngRow, 4).Value
                .Location = wksSheet.Cells(lngRow, 5).Value
                .Duration = wksSheet.Cells(lngRow, 2).Value
                .Categories = wksSheet.Cells(lngRow, 7).Value
                .ReminderMinutesBeforeStart = 60
                .ReminderPlaySound = True
                .ReminderSet = True
                .Save
                .MeetingStatus = olMeeting
                .RequiredAttendees = wksSheet.Cells(lngRow, 6).Value
                .Send
            End With
            Set objTermin = Nothing
        End If
    Next lngRow
Fin:
    If Err.Number <> 0 Then MsgBox "Fehler: " & _
        Err.Number & " " & Err.Description
    Set objFolder = Nothing
    Set objTermin = Nothing
    Set objOutApp = Nothing
    If Err.Number = 0 Then MsgBox "Termine nach Outlook übertragen!"
    
Set wksSheet1 = ThisWorkbook.Worksheets("Angelegte Termine")
    
ActiveSheet.Range(Cells(4, 7), Cells(ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row, 1)).Cut

End Sub

Private Function fncPointExist(ByVal objTMP As Object, ByVal strBody As String) As Boolean
    Dim objItem As Object
    For Each objItem In objTMP.Items
        If objItem.Body = strBody Then fncPointExist = True
    Next
End Function

Nun benötige ich einen Befehl, welcher die Startzeit definiert.

Ich hoffe ihr habt eine Idee und bedanke mich bereits im Voraus! 

Gruß
Christian

[Crazy Tom]

Hallo

wird dir die Startzeit immer mit 10:00Uhr eingetragen?

wenn ja dann liegt das an der Codezeile

Code:

With objTermin
               .Start = Format(wksSheet.Cells(lngRow, 1).Value, "dd.mm.yyyy") & " 10:00"

sollte der Startermin in einer Zelle stehen könnte man es so machen

Code:

With objTermin
               .Start = Format(wksSheet.Cells(lngRow, 1).Value, "dd.mm.yyyy") & Format(wksSheet.Cells(lngRow, 8).Value, " hh:mm")

in meinem Test steht die Uhrzeit in Spalte H

MfG Tom

[croap]

Echt klasse!

Danke dir Tom.

So einfach und doch so fern für mich

Viele Grüße
Christian