Excel VBA - 如何格式化时间格式的用户窗体文本框(Excel VBA - How to format a UserForm TextBox in Time Format)

 我在Excel中创建一个UserForm，它将在我的Outlook日历中创建一个约会。 除了开始和结束时间以外，一切都在工作。 下面是我的代码，其中DTPicker1是约会的日期，DTPicker2和DTPicker3分别是开始和结束时间。 它们采用dtpTime格式。 约会是在正确的日期和主题上创建的，除了时间之外，一切都正常工作。 不知道我应该如何解决它。 任何帮助表示赞赏。 谢谢！ 
 
Private Sub CommandButton1_Click()
Dim olApp As Outlook.Application
Dim olAppItem As Outlook.AppointmentItem
Dim r As Long

On Error Resume Next
Worksheets("Sheet1").Activate

Set olApp = GetObject("", "Outlook.Application")
On Error GoTo 0
If olApp Is Nothing Then
    On Error Resume Next
    Set olApp = CreateObject("Outlook.Application")
    On Error GoTo 0
    If olApp Is Nothing Then
        MsgBox "Outlook is not available!"
        Exit Sub
    End If
End If

Dim mysub, myStart, myEnd
    mysub = TextBox1
    myStart = DTPicker1 & DatePicker2
    myEnd = DTPicker1 & DatePicker3
    Set olAppItem = olApp.CreateItem(olAppointmentItem) 'creates a new appointment
    With olAppItem
        'set default appointment values
        .Location = ""
        .Body = ""
        .ReminderSet = True
        .BusyStatus = olFree
        .RequiredAttendees = ""
        On Error Resume Next
        .Start = myStart
        .End = myEnd
        .Subject = TextBox1
        .Attachments.Add ("c:\temp\somefile.msg")
        .Location = ""
        .Body = ""
        .ReminderSet = True
        .BusyStatus = olBusy
        .Categories = "Orange Category" 
        On Error GoTo 0
        .Save 'saves the new appointment to the default folder
    End With
Set olAppItem = Nothing
Set olApp = Nothing
MsgBox "Done !"
End Sub

I am making a UserForm in excel that will create an appointment in my Outlook Calendar. Everything is working except the start and end times. Below is my code where DTPicker1 is the Date of the appointment and DTPicker2 and DTPicker3 are the start and end times respectively. They are in dtpTime format. The appointment is created on the right date and subject and everything works correctly except the times. Not sure what I'm supposed to do to fix it. Any help is appreciated. Thanks!
 
Private Sub CommandButton1_Click()
Dim olApp As Outlook.Application
Dim olAppItem As Outlook.AppointmentItem
Dim r As Long

On Error Resume Next
Worksheets("Sheet1").Activate

Set olApp = GetObject("", "Outlook.Application")
On Error GoTo 0
If olApp Is Nothing Then
    On Error Resume Next
    Set olApp = CreateObject("Outlook.Application")
    On Error GoTo 0
    If olApp Is Nothing Then
        MsgBox "Outlook is not available!"
        Exit Sub
    End If
End If

Dim mysub, myStart, myEnd
    mysub = TextBox1
    myStart = DTPicker1 & DatePicker2
    myEnd = DTPicker1 & DatePicker3
    Set olAppItem = olApp.CreateItem(olAppointmentItem) 'creates a new appointment
    With olAppItem
        'set default appointment values
        .Location = ""
        .Body = ""
        .ReminderSet = True
        .BusyStatus = olFree
        .RequiredAttendees = ""
        On Error Resume Next
        .Start = myStart
        .End = myEnd
        .Subject = TextBox1
        .Attachments.Add ("c:\temp\somefile.msg")
        .Location = ""
        .Body = ""
        .ReminderSet = True
        .BusyStatus = olBusy
        .Categories = "Orange Category" 
        On Error GoTo 0
        .Save 'saves the new appointment to the default folder
    End With
Set olAppItem = Nothing
Set olApp = Nothing
MsgBox "Done !"
End Sub

原文：https://stackoverflow.com/questions/41309744