通过用户表单设置Outlook约会数据

时间:2017-09-24 18:40:49

标签: excel vba excel-vba outlook

我正在尝试从userform中的Excel设置Outlook约会。如果我引用单元格,代码可以工作。如何在userform中引用框?我还需要添加会议的代码收件人,我将从不同的列表工作表中引用。

以下是引用Excel中单元格的代码,它通过单击工作表中的按钮来工作:

Sub AddAppointments()
    ' Create the Outlook session
    Set myOutlook = CreateObject("Outlook.Application")

    ' Start at row 2
r = 2

Do Until Trim(Cells(r, 1).Value) = ""
    ' Create the AppointmentItem
    Set myApt = myOutlook.CreateItem(1)
    ' Set the appointment properties
    myApt.Subject = Cells(r, 1).Value
    myApt.Location = Cells(r, 2).Value
    myApt.Start = Cells(r, 3).Value
    myApt.Duration = Cells(r, 4).Value
    ' If Busy Status is not specified, default to 2 (Busy)
    If Trim(Cells(r, 5).Value) = "" Then
        myApt.BusyStatus = 2
    Else
        myApt.BusyStatus = Cells(r, 5).Value
    End If
    If Cells(r, 6).Value > 0 Then
        myApt.ReminderSet = True
        myApt.ReminderMinutesBeforeStart = Cells(r, 6).Value
    Else
        myApt.ReminderSet = False
    End If
    myApt.Body = Cells(r, 7).Value
    myApt.Display
    r = r + 1
Loop
End Sub

这是我尝试将代码更改为用户窗体中的引用框:

Private Sub Cmdappointment_Click()

Dim outlookapp As Object
'the mail item is the contents inside a mail
Dim mitem As AppointmentItem
'created outlook app
Set outlookapp = CreateObject("outlook.Application")
'it will open a new application
Set outlookapp = New Outlook.Application
'Set mail item
Set mitem = outlookapp.CreateItem(olMailItem)
Do Until userform2.TextBox4.Value = ""

    ' Create the AppointmentItem
    Set myApt = myOutlook.CreateItem(1)

    ' Set the appointment properties
    On Error Resume Next

    mitem

        myApt.Subject = Me.texbox4.Value
        myApt.Location = Me.texbox3.Value
        myApt.Start = Me.ComboBox1.Value
        myApt.Duration = Me.ComboBox2.Value
        ' If Busy Status is not specified, default to 2 (Busy)
        If Me.ComboBox3.Value = "" Then
            myApt.BusyStatus = 2
        Else
            myApt.BusyStatus = Me.ComboBox3.Value
        End If
        If Me.TextBox1.Value > 0 Then
            myApt.ReminderSet = True
            myApt.ReminderMinutesBeforeStart = Me.TextBox1.Value
        Else
            myApt.ReminderSet = False
        End If
        myApt.Body = Me.TextBox2.Value
        myApt.Display

    End With
Loop

End Sub

2 个答案:

答案 0 :(得分:0)

Sub cmdappointment_Click()
    ' Create the Outlook session
    Set myOutlook = CreateObject("Outlook.Application")


    Do Until userform2.TextBox4.Value = ""
        ' Create the AppointmentItem
        Set myApt = myOutlook.CreateItem(1)
        ' Set the appointment properties
        myApt.Subject = userform2.TextBox4.Value
        myApt.Location = userform2.TextBox3.Value
        myApt.Start = userform2.ComboBox1.Value
        myApt.Duration = userform2.ComboBox2.Value
        ' If Busy Status is not specified, default to 2 (Busy)
        If userform2.ComboBox3.Value = "" Then
            myApt.BusyStatus = 2
        Else
            myApt.BusyStatus = userform2.ComboBox3.Value
        End If
        If userform2.TextBox1.Value > 0 Then
            myApt.ReminderSet = True
            myApt.ReminderMinutesBeforeStart = userform2.TextBox1.Value
        Else
            myApt.ReminderSet = False
        End If
        myApt.Body = userform2.TextBox2.Value
        myApt.Display
    Exit Do
    Loop


End Sub

答案 1 :(得分:0)

对不起,评论中的代码不合适,所以这里有几个问题......

您正在创建<textarea cols="30" rows="4" (input)="str = $event.target.value"></textarea> 并使用outlookapp对象 此外,您还分别从myOutlookmitem创建了两个邮件myAptoutlookapp。最终仅使用myOutlook。我不知道myApt的起源。但我会重写代码只使用一组。 一组OutLook和MailItem对象,就像在工作表应用程序中一样

myOutlook

要添加收件人,请执行以下

Set outlookapp = CreateObject("outlook.Application")
'it will open a new application
Set outlookapp = New Outlook.Application
'Set mail item
Set mitem = outlookapp.CreateItem(olMailItem)
Do Until userform2.TextBox4.Value = ""

    ' Create the AppointmentItem
    Set myApt = myOutlook.CreateItem(1)

为了使它更安全,我还要添加以下行

myApt.Recipients.Add('j doe')