Excel VBA - 如何以时间格式格式化UserForm TextBox

时间:2016-12-24 02:15:57

标签: excel vba userform

我在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

2 个答案:

答案 0 :(得分:0)

如果是我,我会在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

答案 1 :(得分:0)

我发现了自己的错误。我需要在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