Excel VBA - 如何以时间格式格式化用户窗体文本框

Excel VBA - How to format a UserForm TextBox in Time Format

我正在 excel 中创建一个用户表单,它将在我的 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

如果是我,我只会将 UI 设置为任何合适的日期时间,然后在提交到 Outlook

时在 VBA 中格式化该单元格
Dim startDate
Dim endDate
startDate = Format(Range("A1").value, "yyyy-mm-dd")
endDate = Format(Range("A2").value, "yyyy-mm-dd")
' upload to outlook startDate, endDate, appointment details

我发现了我的错误。我需要用 space 将 myStart 和 myEnd 中的两个变量分开,并用“&”而不是“+”连接它们,如下面的代码所示。我还需要在我的时间 DTPicker 上使用 TimeValue 函数来正确格式化它。感谢大家的参与!

    Dim mysub
    Dim myStart, myEnd As Date
    mysub = TextBox1
    myStart = DTPicker1 & " " & TimeValue(DTPicker2)
    myEnd = DTPicker1 & " " & TimeValue(DTPicker3)
    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 = .Subject
        .ReminderSet = True
        .BusyStatus = olBusy
        .Categories = "Orange Category" 'add this to be able to delete the test appointments
        On Error GoTo 0
        .Save 'saves the new appointment to the default folder